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ABSTRACT 


The  Standard  Ship  Motion  Program,  SMP,  was  developed  at  the  Carde- 
rock  Division,  Naval  Surface  Warfare  Center,  and  documented  in  1981  as 
a  prediction  tool  for  use  in  the  Navy’s  ship  design  process.  SMP  pro¬ 
vides  predictions  of  the  response  of  a  ship  advancing  at  constemt  forward 
speed  with  arbitrary  heading  in  both  regular  smd  irregular  seas.  In  1984, 
a  number  of  corrections  and  enhancements  were  hnished  and  documented. 

In  1987,  the  Naval  Sea  System  Command  installed  an  undocumented 
FORTRAN  77  version  on  their  Digital  VAX  hardware.  From  there  SMP 
migrated  to  the  personal  computer.  Additiomd  features  and  improvements 
have  been  made.  Predictions  of  horizontal  force  estimator  were  incorpo¬ 
rated  into  SMP.  An  option  was  added  to  reduce  run  time  and  minimize 
unwanted  output.  Extra  wave  frequency  sets  designed  for  smsill  boats  were 
also  added. 


ADMINISTRATIVE  INFORMATION 

The  SMP93-PC  updates  were  performed  at  the  Carderock  Division,  Naval  Surface 
Warfare  Center,  (CARDEROCKDIV)  over  the  years  1991  to  1993.  This  documentation 
was  funded  by  the  United  States  Coast  Guard  (USCG)  through  CARDEROCKDIV 
work  unit  numbers  1-1561-059-01  and  1-5610-353-01.  The  fund  code  for  this  task  is 
28693  and  the  USCG  authorization  reference  is  DTCG23-93-F-AWP003. 

INTRODUCTION 

The  Standard  Ship  Motion  Program,  SMP* ,  was  developed  over  a  number  of  years 
at  the  Carderock  Division,  Naved  Surface  Warfare  Center,  (CARDEROCKDIV)  ^  and 
finally  documented  in  1981.  This  progrcim  provides  a  standau-d  ship  motion  prediction 
tool  for  use  in  the  Navy’s  ship  design  process.  It  wais  enhanced  and  updated  in  1984^. 
These  two  early  versions,  designated  SMP81  and  SMP84,  raui  on  Carderock’s  mainframe 
computer,  a  CDC  CYBER  6600  (FORTRAN  IV)  and  later  on  a  VAX  (FORTRAN  77). 

The  early  PC  version  of  SMP,  developed  in  early  1988,  was  based  on  the  VAX  (FOR¬ 
TRAN  77)  version  of  SMP84,  maintained  by  Naval  Sea  System  Command  (NAVSEA) 
Code  55W3  and  designated  unofficially  as  SMP87.  It  should  be  noted  that  this  VAX 

^Then  named  David  Taylor  Naval  Ship  Research  and  Development  Center  (DTNSRDC) 
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version  of  SMP84  Wcis  altered  by  NAVSEA  staff  to  “improve”  the  wave  frequency  ranges 
selected  automatically  for  ships  with  shorter  roll  periods  than  those  normall}^  associated 
with  carriers  or  destroyers  and  frigates  and  thus  became  SMP87.  SMP87  was  used  as 
normal  practice  by  NAVSEA;  CARDEROCKDIV;  and  other  US  Government  agencies 
in  ship  design  and  related  studies. 

The  deployment  of  an  intial  version  of  SMP87-PC  on  the  USS  Constellation  in  the 
Indian  Ocean  clearly  brought  out  the  need  to  simplify  the  SMP  input  interface  for  the 
user.  As  a  result,  a  PC  user  interface,  PREDICT^,  was  developed  to  run  SMP. 

It  is  necessary  when  using  SMP  to  define  both  the  base  range  and  distribution 
of  wave  frequencies  for  the  computed  transfer  functions.  All  other  required  transfer 
function  values  at  frequencies  of  the  encountered  waves  are  obtained  from  this  basic  set 
by  interpolation.  SMP  relieves  the  user  of  the  chore  of  providing  this  wave  frequency 
information  by  automatically  selecting  a  suitable  range  of  these  wave  frequencies.  This 
choice  is  made  on  the  basis  of  the  natural  roll  frequency  from  a  set  of  frequency  ranges 
“built  into”  the  program. 

The  early  versions  SMP,  SMP81  and  SMP84,  contained  just  two  built  in  wave 
frequency  ranges.  The  transfer  functions  at  the  base  frequencies  must  be  calculated 
with  a  fine  enough  resolution  to  permit  a  good  definition  of  the  narrow  banded  roll 
response. 

In  1991,  two  studies  of  a  USCG  Buoy  Tender  (WPB),  identified  the  need  for  extra 
frequency  sets  that  provide  adequate  resolution  for  the  transfer  functions,  especially  for 
roll.  The  third  wave  frequency  set,  added  by  NAVSEA,  resulted  in  numerical  instabili¬ 
ties  of  the  responses,  particularly  those  related  strongly  to  roll,  for  these  smaller  ships. 
These  instabilities  were  illustrated  by  erratic  variations  of  the  root  mean  square  (RMS) 
responses  with  consecutive  heading  values  or  ship  speed.  The  modification  of  the  third 
wave  frequency  range  to  account  for  the  responses  of  the  much  smaller  Buoy  Tender 
(WPB)  forced  a  revision  of  the  PC  based  SMP87  and  was  designated  SMP91-PC  (dated 
4/21/91). 

Later  work  with  the  1993  USCG  Seakeeping  Criterion  Definition  Program  resulted 
in  the  addition  of  a  fourth  wave  frequency  range.  The  resulting  program  designated 
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SMP93-PC  now  contains  the  four  ranges  of  wave  frequencies  where  the  most  recent 
addition  was  the  one  required  for  small  boats  (47  -  110  feet). 

The  collective  set  of  updates  to  SMP84,  that  result  in  SMP93-PC,  are  designated 
as  the  SMP93-PC  updates.  They  include; 

1.  Changes  in  FORTRAN  source  code  due  to  change  from  CDC  CYBER  to  VAX. 

2.  Changes  in  FORTRAN  source  code  due  to  change  from  VAX  to  PC  compiler. 

3.  Addition  of  Origin  transfer  function  (ORG)  file  only  run  option. 

4.  Addition  of  horizontal  force  estimator  response^ 

5.  Two  extra  wave  frequency  sets  with  frequency  resolution  appropriate  for  ships 
and  boats  with  short  roll  periods. 

This  report  deals  just  with  the  updates  to  the  SMP84  version^  that  result  in  SMP93- 
PC.  The  theory  for  the  predictions  are  documented  in  References  1  and  2,  and  will  not  be 
repeated  here.  The  changes  to  the  input  description  are  minimal  and  only  the  changes 
since  SMP84  will  be  dealt  with  in  this  report.  References  1  and  2  fully  document  the 
input  “deck”  description  for  SMP84. 

PC  ASPECT  OF  SMP93 

The  PC  version  of  SMP  is  coded  in  Labey  FORTRAN  77  and  requires  a  math  co¬ 
processor  to  run.  Appendix  A  describes  linking  SMP93-PC  using  overlays.  Though 
the  code  has  not  been  converted  to  a  32  bit  compiler,  using  one  would  probably  avoid 
overlay  linking. 

The  differences  between  SMP  versions  due  to  FORTRAN  compilers  deal  mainly 
with  the  opening  and  closing  of  files.  Random  access  files  needed  restructuring.  Also 
the  subroutine  CPINTG  was  made  double  precision  to  avoid  numerical  difficulties  due 
to  loss  of  accuracy  from  the  60-bit  word  (CDC  CYBER)  to  the  32-bit  word  (VAX  and 
PC). 

Additionally,  four  new  utility  subroutines  were  added:  ELTIME,  EXP,  RDSMPSYS, 
and  SLENGTH.  Table  1  lists  the  new  subroutines  and  their  function.  Subroutine  SECT 
has  been  renamed  SECTl,  but  still  performs  the  same  functions. 
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Table  1.  Subroutine  new  to  SMP93-PC  and  their  function.  ^ 
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Also  the  common  block  10  was  changed.  The  new  common  block  is: 

COMMON  /lO/  SYSFIL,POTFIL,COFFIL,LCOFIL,ICARD,TEXFIL,IPRIN. 
2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL , POTFIL , COFFIL , LCOFIL , ICARD , TEXFIL . IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 


ELTIME  Calculates  elapsed  time  using  DOS  functions. 

EXP  Avoids  underflow  with  Lahey  FORTRAN  77  EXP  function. 

RDSMPSYS  Read  SMPSYS.TEX  and  sets  file  names  and  paths. 
SLENGTH  Returns  the  length  of  a  character  string. 


And  the  common  block  SMPSYS  was  added  to  subroutines:  AINPUT,  EQMOTN, 
HSTAT,  HYDCAL,  INPUT,  LRAOOUT,  OUTPUT,  ROAOUT,  RDBASE,  READ, 
REGWAV,  RMSOUT,  RMSTOE,  SEVMOT,  SPLNFT,  and  WAVMAK. 

COMMON  /SMPSYS/  FIS, AS, SIS, SOS, SDS, HALOS, DEV. PRN,SMPPS,SMPIS, 

2  SMPOS , SMPDS , SHPTYPS , SHIPS , VARS ,CYCLS .TITLES , OPTION , LSIS , LSOS , 

2  LSDS , LHALOS , LDEV , LPRN , LSMPPS , LSMPIS , LSMPOS , LSMPDS , LSHPTYPS , 

2  LSHIPS.LTITLES 
CHARACTER*160  AS 

CHARACTER*80  FIS, SIS, SOS, SDS, TITLES 

CHARACTER+20  HALOS ,DEV ,PRN , SMPPS , SMPIS , SMPOS , SMPDS , SHPTYPS 
CHARACTER  SHIPS*6,VARS*2,CYCLS*2 
INTEGER+2  OPTION 


Rather  than  listing  all  the  source  code  differences  individually.  Appendix  B  has  a 
complete  listing  of  the  SMP93-PC  version  source  code.  Though  the  PREDICT  user’s 
manual^  has  a  listing  of  an  early  version  of  SMP93-PC  source  code  and  a  brief  descrip¬ 
tion  of  the  changes,  this  report  is  more  complete,  and  should  be  used  as  the  definitive 
reference  for  SMP93-PC. 

RUNNING  SMP93-PC 

SMP93-PC  can  be  run  as  either  a  stand-alone  program  or  using  a  user  interface, 
such  as  PREDICTS 
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Running  SMP93-PC  stand  alone 

The  steps  for  running  SMP93-PC  as  a  stand  alone  program,  aissuming  a  directory 
structure  is  in  place,  are: 

1.  Change  directory  to  SMP  input  directory  and  make  changes  to  SMP  input  file  if 
needed. 

2.  Change  directory  to  SMP  executable  directory. 

3.  Update  SMPSYS.TEX  if  needed. 

4.  Run  SMP93-PC  executable. 

To  run  SMP93-PC  as  a  stand  alone  program  requires  a  specific  directory  structure, 
file  location,  and  naming  convention.  When  SMP93-PC  runs,  it  reads  a  control  file, 
SMPSYS.TEX,  for  the  names  and  directory  paths  of  the  input  and  output.  SMP¬ 
SYS.TEX  must  be  named  SMPSYS.TEX  and  must  be  in  the  same  directory  as  the 
SMP93-PC  executable.  See  Figure  1  for  an  example  directory  structure.  Figure  2 
shows  an  example  SMPSYS.TEX  file  that  corresponds  to  the  directory  tree  in  Figure  1. 

SMP93-PC  generates  file  names  and  paths  using  the  information  in  SMPSYS.TEX. 
To  change  file  names  and  path,  edit  SMPSYS.TEX  and  change  only  the  data  after  the 
equals  (=)  sign. 

The  directory  tree  and  nauning  convention  seen  in  Figure  1  are  briefly  described 
next. 

Directory  structure  The  directory / sub-directory  structure  is  mandatory,  though 
their  names  can  be  any  valid  DOS  name.  The  directory  names  must  match  the  paths 
given  in  SMPSYS.TEX.  SHIP  TYPE,  e.g.  DESTROYR,  is  a  sub-directory  of  the  directo¬ 
ries  named  in  the  SMP  INPUT  PATH,  e.g.  SMPINPUT,  and  SMP  OUTPUT  PATH,  e.g. 
SMPOUTPT.  CURRENT  SHIP,  e.g.  DD965,  is  used  as  the  basis  for  the  file  names  and  as 
a  subdirectory  of  SMP  DATA  PATH,  e.g.  SMPDATA. 
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Fig.  2.  Example  SMPSYS.TEX  file. 
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Naming  convention  ;  The  SMP  input  file  is  the  concatenation  of  the  CURRENT 
SHIP,  VARIANT,  and  CYCLE  variables  with  INP  for  an  extension,  e.g.  DD965H6 .  IKP. 
The  CURRENT  SHIP  variable,  e.g.  DD965,  has  a  maximum  length  of  five  characters. 
The  variant  typically  indicates  major  changes  to  the  input  file  and  the  cycle  keeps  track 
of  the  number  of  times  the  file  has  been  changed. 

The  SMP  output  files  are  the  concatenation  of  CURRENT  SHIP  and  VARIANT, 
e.g.  DD965H  with  the  appropriate  extension.  The  files  and  their  extension  are  discussed 
in  the  OUTPUT  section. 

Running  SMP93-PC  using  PREDICT 

PREDICT^  is  a  menu  driven  shell  that  allows  the  user  to  choose,  view,  and  edit 
input  SMP  files,  run  SMP93,  select  output  files  to  save,  and  make  polar  plots  of  the 
responses,  or  plots  of  the  hull  form.  PREDICT  uses  the  same  directory  structure  and 
naming  convention  used  when  running  SMP93-PC  as  a  stand-adone  program.  Figure  1. 
The  PREDICT  user’s  manual^  describes  the  file  structure  and  naming  convention  fully. 
PREDICT  also  provides  the  option  to  continue  and  generate  time  history  data  using 
Simulation  Time  History  and  Access  Time  History  programs®.  Figure  3  shows  the 
overview  of  PREDICT  and  where  SMP93-PC  fits  into  it.  Table  2  gives  a  brief  descrip¬ 
tion  of  the  different  parts  of  the  PREDICT  package. 

UPDATES  TO  THEORY 

The  ship  motion  theory  used  for  the  predictions  is  the  same  for  the  PC  version  as 
for  the  VAX  and  CDC  versions.  It  is  assumed  the  user  is  already  familiar  with  the  ship 
motion  theory,  variables,  coordinate  system,  files,  and  input/output  schemes  that  are 
described  in  the  SMP  User’s  Msmual.^’  ^  These  details  will  not  be  repeated  here. 

SMALL  BOAT  FREQUENCY  RANGES 

The  original  two  wave  frequency  sets  have  frequency  resolution  in  the  range  most 
applicable  to  carriers,  destroyers,  and  frigates.  The  original  third  frequency  set  had 
numerical  instabilities  with  ships  smaller  than  frigate  size,  with  natural  roll  periods  less 
than  nine  seconds.  This  was  especially  noted  in  responses  that  had  a  roll  component. 
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PREDICT 


Fig.  3.  PREDICT  applications  manager  organizational  structure 


Table  2.  PREDICT  sub-program  descriptions. 


Program 

Description 

PREDMAIN 

The  top  level  menu  and  link  between  the  frequency,  time  do¬ 
main,  and  plotting  branches  of  PREDICT. 

SMPMAIN 

The  main  menu  for  the  frequency  domain  branch  of  PREDICT. 

SMP 

Frequency  domain  predictions  of  ship  motion.  Uses  most  recent 
version. 

SMPEDIT 

Editor  for  SMP  input  hies  that  keeps  track  of  hie  naming  con¬ 
vention  and  correct  format  helds  for  data. 

HULLPLOT 

Generates  plots  of  the  hull  form. 

POLAREGA 

Generates  speed  polar  plots  of  the  ship  motion  response. 

STHMAIN 

The  main  menu  for  the  time  domain  branch  of  PREDICT 

STH 

Time  domain  predictions  of  six  degree  of  freedom  response  at 
ship  center  of  gravity. 

ACTH 

Time  domain  predictions  of  absolute  and/or  relative  point 
motion. 

ACTHEDIT 

Editor  for  ACTH  input  hies. 

WRTASC2 

Converts  ACTH  binary  format  output  to  ASCII  format. 

'  I 


CLTMAIN 

DLPLOT 


The  main  menu  for  the  plotting  branch  of  PREDICT. 
Plots  time  histories  of  ACTH  predictions. 


numerical  instabilities  with  ships  smaller  than  frigate  size,  with  natural  roll  periods  less 
than  nine  seconds.  This  was  especially  noted  in  responses  that  had  a  roll  component. 
The  original  two  wave  frenuency  sets  would  have  had  similar  numerical  instabilities  had 
they  been  used  for  smaller  ships. 

The  cause  of  the  numerical  instabilities  in  the  root  mean  square  (RMS)  responses 
as  a  function  of  ship  speed  and  heading  were  traced  to  an  inadequacy  of  the  defined  roll 
transfer  function  frequency  range.  With  only  30  wave  frequencies  per  set,  it  is  important 
to  have  more  wave  frequencies  grouped  near  the  natural  roll  frequency.  With  small  boats 
this  also  means  increasing  the  range  of  modal  wave  periods  to  span  the  shorter  response 
periods. 
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Fig.  4.  Wave  frequency  distribution  for  SMP-93  frequency  sets. 


As  a  result  SMP93-PC  uses  four  wave  frequency  sets.  The  last  two  have  increased 
resolution  in  the  frequency  ramge  most  applicable  to  small  boats.  The  new  wave  fre¬ 
quency  sets,  ranges  if  3  and  if  4,  are  used  when  the  roll  period  is  less  than  or  equal 


Table  3.  SMP93-PC  wave  frequency  set  summary. 


Range 

Type  of  Ship/Boat 

Roll  Period 

Seconds 

Wave  Periods 

Seconds 

Maximum 
Resolution  Range 

Seconds 

#1 

Carriers/large  ships 

>  15 

3.14-31.4 

12.56  -  22.43 

#2 

Frigates /Destroyers 

9  <  Ttf,  <  15 

2.62  -  31.4 

10.47  -  15.70 

#3 

USCG/USN  small  ships 

5  <  <  9 

1.57  -  31.4 

6.28  -  12.56 

#4 

USCG  boats 

<  5 

1.57  -  31.4 

2.09  -  6.28 

The  two  new  wave  frequency  sets,  FREQS  and  FREQ4,  were  added  in  subroutine 
READ.  FREQ3  is:  0.2,  0.3,  0.4,  0.5,  0.55,  0.575,  0.6,  0.625,  0.65,  0.675,  0.7,  0.725,  0.75, 
0.775,  0.8,  0.825,  0.85,  0.875,  0.9,  0.95,  1.0,  1.1,  1.2,  1.3,  1.5,  1.8,  2.0,  2.5,  3.0,  3.5,  and 
4.0.  FREQ4  is:  0.2,  0.4,  0.6,  0.8,  1.0,  1.1,  1.2,  1.3,  1.4,  1.5,  1.6,  1.7,  1.8,  1.9,  2.0,  2.1, 
2.2,  2.3,  2.4,  2.5,  2.6,  2.7,  2.8,  2.9,  3.0,  3.2,  3.4,  3.6,  3.8,  and  4.0. 


HORIZONTAL  FORCE  ESTIMATOR 

SMP93-PC  has  the  capability  to  estimate  the  horizontal  force  at  the  points  defined 
in  the  Motions  at  a  Point  Data  Ciurd  Set.  The  horizontal  force  estimator  (HFE)  is  the 
estimated  ship-referenced  acceleration  in  the  horizontal  plame^.  It  is  a  combination  of 
the  earth  referenced  lateral  acceleration  and  the  horizontal  component  of  gravitational 
acceleration  due  to  roll  (heel).  Thus,  the  horizontal  forces  applied  to  people  and  equip¬ 
ment  on  the  ship  by  the  motions  zure  now  also  predicted.  Horizontal  Force  Estimator  is 
defined  by: 


HFE  =  -^(C,-zC4  +  JCC6)  +  C,  (1) 

Where  C  is  a  transfer  function  with  sub-scripts  2,  4,  and  6  referring  to  sway,  roll, 
and  yaw  respectively.  X  and  Z  are  the  x  and  z  coordinates  of  the  point  locations,  see 
Figure  C-1  of  Reference  1  for  a  coordinate  system  diagram;  Wg  is  the  wave  encounter 
frequency;  and  gr  is  a  gravitationad  constant. 
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SMP  PROGRAM  CHANGES 


INPUT 

The  input  for  SMP  consists  of  underwater  hull  form  shape,  ship  weight  distribution, 
appendage  details,  specific  shipboard  locations,  and  wave  data.  This  input  is  broken 
down  into  15  Data  Card  Sets  which  are  described  in  Appendix  C  of  Reference  1.  The 
modification  to  start  or  stop  after  generating  an  origin  transfer  function  (ORG)  file 
required  changes  to  Data  Cztrd  Set  2  (Program  Options).  The  addition  of  horizontal 
force  estimator  (HFE)  required  changes  to  Data  Card  Set  12,  card  1.  See  Table  4  for  a 
sample  input  file.  The  changes  to  the  two  data  sets  for  these  new  options  are  described 
below: 

ORG  File  Start  and  Stop  Option 

With  this  option  activated,  SMP93-PC  can  either  start  using  an  existing  ORG  file 
or  stop  after  generating  the  ORG  file.  This  provides  a  time  saving  if  only  the  ORG 
file  is  wanted.  The  major  run  option,  OPTN,  must  be  either  4  or  5  to  start  using 
an  existing  ORG  file.  The  ORG  file  contains  the  transfer  functions  of  the  ship’s  six 
degrees-of-freedom  about  the  center  of  gravity. 

The  flag,  ORGOPTN,  was  added  to  Data  Card  Set  2,  Program  Options,  as  the 
seventh  variable  (integer,  column  40).  Possible  values  are: 

0  or  blank  =  Normal  nm. 

1  =  Stop  execution  after  generating  ORG  file.  Do  not  perform  sta¬ 

tistical  calculations. 

2  =  Start  execution  using  an  existing  ORG  file  (OPTN=4  or  5). 

Read  ORG  file  and  perform  statistical  calculations. 

Horizontal  Force  Estimator 

SMP93-PC  has  the  capability  to  estimate  the  horizontal  force  at  the  points  defined 
in  the  Motions  at  a  Point  Data  Card  Set  12.  To  turn  this  feature  on,  set  column  10  of 
Data  Card  Set  12,  card  1,  to  1. 

0  or  blank  =  No  horizontal  force  estimate  calculations  or  output. 

1  =  Horizontal  force  estimates  for  motions  at  point  locations. 


12 


OUTPUT 


The  changes  to  the  output  file  (OUT)  are  minimal.  Horizontal  force  estimates  have 
the  same  format  as  other  response  output.  The  change  in  wave  frequency  ranges  also 
changes  the  range  of  modal  periods  used  for  irregular  seas  calculations.  The  modal 
periods  for  the  new  wave  frequency  sets,  FREQ3  and  FREQ4,  are:  3,  5,  7,  9.  11.  13.  15. 
and  17.  See  Table  5  for  an  example  of  the  output  affected  by  the  input  changes.  Note, 
the  example  assumes  that  the  user  already  has  an  ORG  file,  otherwise  SMP93'PC  will 
stop  before  performing  irregular  seas  calculations  and  there  would  be  no  HFE  response 
tables. 

The  main  difference  between  the  VAX  and  PC  versions  is  the  treatment  of  the 
output  files.  Table  6  gives  a  list  of  the  extensions  used  by  the  SMP93-PC  and  how  they 
compare  with  the  SMP87  version.  The  SPL  file  in  the  SMP87  version  either  has  spline 
fits  of  the  body  plan  or  response  data  for  speed  polar  plots  depending  on  main  run 
option.  SMP93-PC  writes  body  plan  spline  fits  to  the  HPL  file  and  splits  the  response 
data  found  in  the  SPL  file  into  two  files,  SPD  and  SPT,  to  avoid  memory  problems. 
The  SPD  file  has  RMS  response  and  modal  period  data  in  a  binary  format.  The  SPT 
file  has  speed,  heading,  and  response  name  information  in  an  ASCII  format. 

The  PC  output  files  are  written  in  sub-directories  in  the  SMP  DATA  PATH  and  SMP 
OUTPUT  PATH  directories  from  the  SMPSYS.TEX  file.  Only  the  output  file  (OUT), 
run  log  (TEX),  and  hydrostatic  output  (HSTAT.TEX)  are  in  the  SMP  OUTPUT  PATH 
sub-directories.  All  the  rest  are  in  the  SHIP  TYPE  sub-directory  of  SMP  DATA  PATH 
directory,  e.g.  SMPDATA\DESTROYR. 
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Table  4.  Example  SMP93-PC  input  deck. 

«PB  8236  82-  PATROL  BOAT  0  CLASS  FL  5/18/93  PROP  STROPS  IRPOT  AS  PASSIVE  RUDDER 
2  0  0  1  0  0  1 


ST 

1.9905  32. 

17250.00001279 

78.0000 

15.7800  5. 

9500 

72.30 

3.2400 

0.0000  7. 

2100 

0.2500 

21  0 

0.0000 

1 

0 

0.0000 

0.00 

0.0000 

5.95 

1.0000 

5 

0 

1.0000 

0.00 

0.35 

0.71 

0.98 

1.0000 

2.23 

3.00 

4.00 

5.00 

2.0000 

5 

0 

2.0000 

0.00 

0.97 

1.54 

1.96 

2.0000 

2.00 

3.00 

4.00 

5.00 

3.0000 

7 

0 

3.0000 

0.00 

1.00 

1.57 

2.00 

3.0000 

1.83 

2.48 

3.00 

3.45 

4.0000 

6 

0 

4.0000 

0.00 

1.00 

2.00 

3.00 

4.0000 

1.72 

2.24 

2.89 

3.75 

5.0000 

7 

0 

5.0000 

0.00 

1.00 

2.00 

3.00 

5.0000 

1.66 

2.11 

2.59 

3.16 

6.0000 

8 

0 

6.0000 

0.00 

1.00 

2.00 

3.00 

6.0000 

1.63 

2.00 

2.46 

2.86 

7.0000 

9 

0 

7.0000 

0.00 

1.00 

2.00 

3. CO 

7.0000 

1.66 

1.96 

2.32 

2.65 

8.0000 

9 

0 

8.0000 

0.00 

1.00 

2.00 

3.00 

8.0000 

1.68 

1.95 

2.28 

2.61 

9.0000 

9 

0 

9.0000 

0.00 

1.00 

2.00 

3.00 

9.0000 

1.77 

1.99 

2.28 

2.57 

10.0000 

10 

0 

10.0000 

0.00 

0.17 

0.17 

0.24 

10.0000 

1.03 

1.03 

1.20 

1.85 

11.0000 

10 

0 

11.0000 

0.00 

0.17 

0.26 

0.30 

11.0000 

0.92 

0.92 

1.18 

2.08 

12.0000 

10 

0 

12.0000 

0.00 

0.17 

0.28 

0.29 

12.0000 

0.84 

0.84 

1.47 

2.19 

13.0000 

10 

0 

13.0000 

0.00 

0.17 

0.28 

0.31 

13.0000 

0.71 

0.71 

1.47 

2.44 

8.0000 

0.3700 

8.0000 

0.2500 

0.0000 

1.21 

5.95 

2.33 

5.95 

2.39 

4.00 

2.86 

5.00 

3.27 

5.95 

3.80 

5.00 

4.21 

5.95 

4.00 

4.00 

4.65 

5.00 

5.07 

5.95 

4.00 

3.39 

4.72 

4.00 

5.44 

5.00 

5.89 

5.95 

4.00 

3.10 

5.00 

3.69 

5.38 

4.00 

6.15 

5.00 

6.55 

5.95 

4.00 

2.95 

5.00 

3.38 

5.96 

4.00 

6.77 

5.00 

7.11 

5.95 

4.00 

2.91 

5.00 

3.19 

6.00 

3.66 

7.00 

4.59 

7.53 

5.95 

0.52 

1.93 

1.00 

2.07 

3.00 

2.60 

5.00 

3.15 

6.86 

4.00 

7.89 

5.95 

0.95 

2.25 

2.00 

2.45 

4.00 

2.92 

6.00 

3.45 

7.17 

4.00 

8.05 

5.95 

1.00 

2.33 

2.00 

2.59 

4.00 

3.01 

6.00 

3.47 

7.28 

4.00 

8.07 

5.95 

0.75 

2.54 

3.00 

2.96 

5.00 

3.33 

7.20 

4.00 

7.95 

5.00 

8.06 

5.95 
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Table  4.  Continued. 


14.0000 

10 

0 

14.0000 

0.00 

0.17 

0.27 

0.29 

14.0000 

0.63 

0.63 

1.20 

2.19 

15.0000 

10 

0 

15.0000 

0.00 

0.17 

0.26 

0.31 

15.0000 

0.49 

0.49 

1.00 

2.44 

16.0000 

10 

0 

16.0000 

0.00 

0.17 

0.26 

0.30 

16.0000 

0.39 

0.39 

0.80 

2.20 

17.0000 

10 

0 

17.0000 

0.00 

0.17 

0.26 

0.31 

17.0000 

0.25 

0.25 

0.92 

2.65 

18.0000 

7 

0 

18.0000 

0.00 

1.00 

2.00 

4.00 

18.0000 

3.74 

3.83 

3.95 

4.15 

19.0000 

9 

0 

19.0000 

0.00 

1.00 

2.00 

4.00 

19.0000 

4.00 

4.11 

4.21 

4.36 

20.0000 

9 

0 

20.0000 

0.00 

1.00 

2.00 

4.00 

20.0000 

0 

4.29 

4.41 

4.47 

4.59 

1 

9.2308 

n 

17.0000  18 

.0000 

0.0000 

A 

19.2100 

19.6600  3 

.7500 

4.3750 

19.2100 

19.6600  3 

.7500 

1.8750 

18.1649 

18.4923  3 

.9565 

3.8020 

18.3521 

18.5724  4 

.2215 

2.0313 

0 

0  0  0 

3  1 

1  PILOT  BOUSS  AT  HSLKSKAN  CHAIR 

2  FWD  BERTHING,  PORT/TOP  BUNK 

3  MAIN  DECK,  BOAT  DECK,  STBD  RAIL 

3  0 

1  PORT  PROPELLER  TIP  2 

2  STATION  2,  SLAMMING  1 

3  MAIN  DECK, STBD  RAIL  3 

1  2.0000  SIGNIFICANT 

2.6200 

STOP 


0.31 

0.75 

2.17 

5.00 

7.42 

8.05 

2.65 

2.75 

3.00 

3.47 

4.36 

5.95 

0.36 

0.70 

3.00 

5.00 

7.39 

7.97 

2.88 

3.00 

3.34 

3.64 

4.44 

5.95 

0.39 

1.00 

3.00 

5.00 

7.32 

7.87 

2.98 

3.29 

3.56 

3.82 

4.50 

5.95 

0.40 

1.00 

3.00 

5.00 

7.26 

7.74 

3.40 

3.56 

3.80 

4.03 

4.57 

5.95 

6.00 

7.20 

7.58 

4.34 

4.66 

5.95 

5.53 

6.72 

7.14 

7.25 

7.43 

4.43 

4.56 

4.72 

5.00 

5.95 

5.58 

6.76 

7.07 

7.11 

7.22 

4.62 

4.71 

4.79 

5.00 

5.95 

1. 

7824 

0.2500 

3. 

7413 

4.3750 

1.8750 

3.9063 

1.8906 


8.2051 

0.0000 

20.0000 

3.3333 

5.0000 

12.0000 

15.3846 

-7.5000 

10.5000 

18.9017 

4.1600 

3.7500 

0.8538 

2.0000 

0.0000 

2.0000 

0.8538 

15.3846 

-7.5000 

10.5000 

0.8538 
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Table  5.  Example  of  new  parts  of  SMP93-PC  output  file. 
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NO  ^  O  O  p^  r^ 


«-<  o  NO  in  ♦  p^  pq 


p»  o  NO  pq  o  o  o 

O  ^  O  P*'  P»  •H  NO 


O  o  NO  ^  n  Nn  t 


^  ^  ^  P*  ^  ^  f*>  o* 


O*  P*  *r  in  pq  *H  -H 


00  ®  in  in  ®  o  ^ 
^  p»  NO  pq  PN  o  ^ 


o  NO  ^  pv  pq  ^  «-N 
^  ^  ^  ^  ^  V 


^  ^  in  m  ^  p“  m 


^CDrHOpqiO^  W  P^  p*  SO  O'  -q*  « 
ONNOin^r-spqrq  soinpipq* 


U 

s 


^  r.  pq  O'  P^  o 
O'  pq  O'  O  fn  O'  VO 


p^  ®  in  ®  ®  in  pq 

®  'O  ®  ®  p'  o  ® 


wo  in  n  PI  pq  ^  <-N  p^mpq^^*HO 


®  so  P«»  P»  P»  O'  ® 
p^  pq  p'  p»  p^  O  ® 


P*  O'  O'  O'  p^  m  m 

®  ®  pv  ®  p*  in  ^ 


^p'pq-^'-^^o  ^..^^oooo 


O'  O'  ®  ®  O'  ®  O' 
O'  ®  O'  O'  ®  ®  O' 

ooooooo 

ooooooo 


O'  O'  O'  O'  O'  O' 
O'  O'  O  O'  O'  O' 

w 

O  O  O  O  O  O 

O  O  O  o  o  o 


o 

&- 


OOOOOOO  OOOOOO 


Lnr*‘0''-^p'inp«»  inp-o-'-Np'inp* 
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ee/ooo 


Table  6.  Description  of  possible  SMP  output  files. 


SMP87  VAX 

Extension 

BSC 

SPL 

SMP 

OUT 

ORG 

RMS 

SPL 

SPL 

FORTRAN 

Unit 

C<5 

T}< 

o 

CO 

Tj* 

lO 

50 

oo 

Data 

Type 

Binary 

Binary 

Binary 

ASCII 

ASCII 

Binary 

ASCII 

Binary 

Binary 

Binary 

Binary 

Binary 

ASCII 

Binary 

Binary 

SMP93 

Extension 

POT 

COF 

LCO 

HPL 

INP 

LRA 

OUT 

ORG 

RAO 

RMS 

SEV 

SPD 

SPT 

LAC 

LAE 

Description 

Potential  flow  velocity  potential 

Added  mass  and  damping,  excitation 

Loads 

Spline  fit  of  offsets  for  HULLPLOT 

Ship  input  data 

Response  operators  for  loads 

Hydrostatics,  roll  damping,  and  response  output 

Ship  origin  transfer  functions 

Response  amplitude  operators 

Response  RMS  for  unit  wave  height 

Worst  case  response  and  sea  conditions 

RMS  response  data  for  speed  polar  plots 

Labels  and  titles  for  speed  polar  plots 

Frequency  domain  coefficients 
for  rudder  roll  stabilization 

Frequency  domain  coefficients 
for  rudder  roll  stabilization 

Menu  choice 

Potential  file 

Coefficient  file 

Load  coefficient  file 

Hull  plot  file 

Input  file 

Load  response  operator  file 

Output  file 

Origin  file 

Response  operator  file 

RMS  file 

Severe  motion  file 

Speed  polar  data  file 

Speed  polar  text  file 

Lateral  coefficient  file 

Lateral  excitation  file 
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APPENDIX  A:  LINKING  SMP93-PC  USING  OVERLAYS 

Due  to  memory  constraints,  it  is  necessary  to  link  SMP93-PC  using  an  overlay 
loader.  The  authors  used  an  overlay  loader  designed  for  the  PC  called  PCLINK,  a  third 
party  program.  Table  7  hat  the  PCLINK  overlay  instructions  assuming  the  object  files 
reside  in  the  directory  C:\SMPPC\SMP.  The  current  version  of  SMP93-PC  has  not  been 
converted  to  the  newer  32  bit  compilers.  Such  a  conversion  should  be  straight  forward 
and  would  probably  result  in  further  restructuring  of  the  random  access  files  and  not 
require  an  overlay  loader  to  link  the  program. 


Table  7.  PCLINK  overlay  instructions  for  SMP93-PC. 


OUTPtJT  C:\SMPPC\SMP 

FILE  SMP93  ,  ALGRNG,  ATAN2D,BMAX,  CPFIT,  CPINTG.  CPLVAL,  LRAO,  RAOPHA, 

SPINTG, SPFIT, SPLVAL, EXP, ELTIME, SLENTH,RDSMPSYS,  PRELIM 
OVERLAY  F77LC0DE, F77LDATA, F77LCOMN 
BEG  SECT  PILE  INPUT, CUBC02 , SPINT2 , SPLNT2 

BEG  SECT  FILE  READ, AINPUT,GENOFS,BRWVSP, SPLNAR 

SECT  FILE  HSTAT, NORMAL, VUNIT2,CONIWT,PDER,PADD,RSOLVE,SPPLV2, 
N0RMT5 , RDCOMP, PMPY, PVAL, PINT,  TRIM, SPLNFT 
SECT  FILE  HSTOUT 

END 

SECT  FILE  REGWAV,CDCOMP,CSOLVE,EDMKSP,FINTSP,REVAL,SKFRSP 
BEG  SECT  FILE  HYDCAL 

BEG  SECT  FILE  HYD2D,  TWODPT,  GRNLOG,  GRNFRQ,ALAG,  EXPINT,  WTPELM,  ATAN3 
SECT  FILE  T3DAMD,RPHI2D,T2DAMD,AMDPRN 
SECT  FILE  COFOUT,AMD,RDPELM,EXFOR 

END 

SECT  FILE  RDBASE,RDPRIN,WAVMAK,HLLIFT,RDLIFT,SKLIFT,BKLIFT,FNLIFT, 
SKNFRC ,  RDEDDY ,  HLEDDY,  BKEDDY,  FNEDDY ,  CEVAL ,  SECTl ,  TANAKA , 
Vise,  SERAB,  SERD,  SERE,  FTWO,  FIG56 ,  FIG7 ,  FIGS ,  FIGIO ,  FIGll , 
CALRGM,  BILGEK,  CMINR,  SBEDDY,  SBLIFT 
SECT  FILE  EQMOTN, LIMIT, SOLVE, CLIP, TRNLAT,RDEVAL,RVSLAT,LSCOF, 
INERST,ACTFIN 

END 

SECT  FILE  IRGSEA,RMSTOE,WEDEFN,RAOPHS,PRAO,ADRES,ORAO,VELACC,RELMOT, 
RMS ,  TOE ,  PSPSC ,  SCB2 ,  XMSSC ,  PSPLC ,  INTRPL ,  TEPEAK ,  FNRAO 
SECT  FILE  OUTPUT, RSTITL,RLITR 
BEG  SECT  FILE  RAGOUT, ORGRAO, TFNFIT 
SECT  FILE  LRAOUT 

SECT  FILE  RMSOUT,RLITER,  FETCH,  DKWSLM,SETSEV,SEVMOT 

END 

END 
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APPENDIX  B;  SMP03-PC  SOUHCI:  CODE  LISTING 


1  Ills  ajipciuHx  is  ;i  listing  of  the  source  code  similar,  luit  not  idfuitical.  to  Ai)i>eiuii\ 
of  Kef'  rence  1 . 


C  SMP93  PROGRAM  LIBRARY 


PROGRAM  SMP93 


Standard  Ship  Motion  Program  (SKP93) 
for  Paraonal  Computers 


Operating  system  MS-DOS  Version  4.0) 
fortran  77  using  Lahey  Fortran 
Overlay  linking  using  FLINK86 


Hull  plot  and  Speed  Polar  plots 
done  in  separate  programs 
using  HALO  graphics  language 


C  SUBROUTIME  LIST 


C  DECK  ACTFIN  -  active  fins 

SUBROUTINE  ACTFIN  (IV ,2ER0 . V , 0MGE,0MGE2 ,TAF) 

COMMON  /AFFEKD/  KBKSET .KCKSTS (2) ,BKIMAC(2) .BKFSC2) ,fiKAS(2) , 

2  BKWD(2) ,DHSTN(10,2) .BKHB(10,2) .BKLNTH.BKWDTH , 

2  BKWL(10,2) ,BKAN(10.2).NSKSET,SKIMAC(2) ,SKFLS(2) .SKALS(2) . 

2  SKAUS(2) ,SKHB(2),SKFLWL(2) ,SKALWL(2) ,SKAUWL(2) ,NRDSET,RDIMAG(2), 

2  RDRFS(2) ,RDRAS(2),RDRHB(2) ,RDRFWL(2) ,RDRAVL(2LRDTFS(2) .RDTAS(2), 
2  RDTHB(2),RDTFWL(2),RDTAWL(2),KSBSET,SBIMAG(2),S0BRFS(2) ,S0BRAS(2) 
2,S0BRHB(2) ,S0BRFW(2  .SQBRAW(2) ,SIBRFS(2) ,S1BRAS(2) ,SIBRHB(2) , 

2  SIBRFW(2) ,SIBRAU(2) .SBTFS(2) ,SBTAS(2) ,SBTHB(2) ,SBrFWL(2) , 

2  SBTAWL(2)  ,JU-'NSET,FNIMAG(2)  ,FNnFS(2)  .FNRAS(2)  . 

2  FNRHB(2),FNRFWL(2),FNRAWL(2).FNTFS(2),FNTAS(2),FNTHB(2) . 

2  FNTFWL(2) ,FNTAWL(2) .MEXPRD.ENRDOCB) .ENRDS(8) 

COMMON  /FINCON/  lACTFN .IFCLCS ,FGAIN(8) ,FK(3) ,FA(3) ,FB(3) , 

2  FCLCS(8,2) 

COMMON  /PHYSCO/  II,TPI,PI,PIOT , DEGRAD , R ADDEG , VKMETR , HETRVK , GR AV , 

2  R5!Q , GNU , RBCS , RHOF , CSUS , GSUF , FTMETR , PUN ITS , REYSCL 
COMPLEX  II 

CHARACTER*4  PUNITS(2) 

REAL  TPI , PI , PICT , DEGRAD , RADDEG , VKMETR , HETRVK , GRAV , RHO , GNU , RHOS , 

1  RHOF, GNUS, GNUF, FTMETR 

COMMON  /RLDBK/  FS0R(25) .BMK(26) ,DK(25) .CAK(25) ,HQ ,HSPAN .HMNCHD , 

2  HAREA.HXCP,HYCP,HZCP,HGAMMA,HYHAT,HEAR.HLCS,RQ(2) ,RSPAN(2) , 

2  RMNCHD(2) ,RAREA(2) .RXCP(2) ,RYCP(2) ,RZCP{2) .RGAMMA{2) ,RYHAT(2) . 

2  REAR(2) .RLCS(2) .SQ(2) .SSPAN(2) .SMNCHD(2) ,SAREA(2) ,SXCP(2) , 

2  SYCP(2),SZCP(2),SGAMMA(2).SYHAT(2),SEAR(2),SLCS(2),BQ(2) , 

2  BSPAN(2) .BMNCHD(2) ,BAREA(2) ,BXCP(2) ,BYCP(2) .BZCP(2) ,BGAMMA(2) , 

2  BYHAT(2) .BEAR(2) ,BLCS(2) ,FQ(2) .FSPAN(2) .FMNCHD(2) ,FAREA(2) , 


^  r  \  ^  /  j  r  I  \  ^  /  fF  \  ^  ,  rvi^nnn  v  »  r  v  ^  , 

2  PQ(2,2) .PSPAH(2,2),PMNCHD(2,2).PAREA(2,2),PXCP(2.2),PYCP(2,2) . 

2  PZCP(2,2),PGAKMA(2,2),PYHAT(2,2) .PEAR(2.2),PLCS(2  2). 

2  STADMPUO) ,SHPDMP(10,8) ,ENC0N ,WPHI ,TPHI ,WMELM(4 .9) ,SFELM(4 ,9 ,8) , 

2  REELM(4,©,8),PEELM(4,9.8),FEE1JM(4,9,8),HEELM(4,9,8) .BEELM(4,9,8) , 
2  ENWM,ENSF(6.8) ,ENRE(8) ,EKPE(6) ,ENFE{8) ,ENHE(8) ,ENBE(8) , 


2  ENEMY (8, 8) ,ENRHB) ,tNPL(e) , t»rL(6) ,tKKL(5) ,EnOL(C) ,CSDL(S) , 
2  ENSHP(8,8),RELH(4,9) .1TS(2B) ,RD(2S) ,EDDY(8,2S) ,RGB(25) 
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REAL  RDBLK(2692) 

EQUIVALENCE  (PSUR(l) ,RDBLK(1) ) 

COMPLEX  TAFC3).FGC,CTERM,2ER0 

DO  10  1=1,3 
TAF(I)  =  ZERO 
10  CONTINUE 

FGC  =  ((FK(:i)-0MGE2*FK(3))+II*0MGE<FK(2))/(((FA(l)-0MGE2*FA(3n  + 

2  II*0MGE*FA(2))*((FB(1)-QMGE2*FB(3))+II*0MGE*FB(2))) 

DO  30  K=1,NFNSET 
XCP  =  FXCP(K) 

ARM  =  -  FHNCHD(K)/6 
THAT  =  FYHAT(K) 

AP  =  PI*RH0*FSPAN(K)*(FMNCHD(K)/2)*+2 
TEMP  =  FLCS(K) 

IF  (IFCLCS  .EQ.  1)  TEMP  =  FCLCS(IV,K) 

FZ  =  (RH0/2)+FAREA(K)*TEMP 
SINGAM  =  SIN(FGAMMA(K)+DEGRAD) 

CTERM  =  FGC*(ARM*AP*0MGE2-II*QMGE+(ARM*F2-3t'AP)*V+FZ*V+V) 

Ml  =  1 

IF  (FNIMAG(K)  .EQ.  2)  Ml  =  2 
*  SIN(i80-GAMMA)=SIN(GAMMA)  FOR  FIN  ON  STBD  SIDE 
DO  2C  M-1  Ml 

TAF(i)  TAF(l)  -  SINGAM*CTERH 

TAF(2)  =  TAF(2)  +  YHAT*CTERH 

TAF(3)  =  TAF(3)  -  SINGAM*XCP*CTERM 

20  CONTINUE 
30  CONTINUE 

RETURN 

ENl’/ 

C  DECK  ADRES 

SUBROUTINE  ADRES  (KL.NU,M0TV,H0TL,HJV,H3L,H7,RA01 ,PHS1,RA02,PHS2, 
2  OMEGA , NMOT . HPLAHE . NOMEG A . RADDEG . COSMU , RHO , IPKS ) 

COMPLEX  MOTVCNMOT.NOMEGA) ,MOTL(NMOT,NOMEGA) ,HJV(NMOT,NOMEGA) , 

2  HJLaNM0T,NQMEGA),H7(N0MEGA) .ARES.TEMPL 

DIMENSION  RAOl(NOMEGA) ,PHSl(NQMEGA) ,RA02(N0MEaA) ,PES2(N0MEGA) , 

2  OMEGA (NOHEGA) 

DO  30  I=HL.HU 

DO  20  J=1,KPLANE 

ARES  =  H7(l) 

DO  10  N=1,NH0T 
TEMPL  =  MOTL(N,I) 

IF  (J  .EQ.  2)  MOTL(N,I)  =  -  MOTL(N,I) 

ARES  =  ARES  +  MOTV.,  ,I)*HJV(N,I)  +  MOTL(N,I)*HJL(N,I) 

MOTL(H,I)  =  TEMPL 
10  CONTINUE 

TEMP  =  -  0.6*RH0*QMEGA(I)*C0SMU*AIHAG(ARES) 

IF  (J  .EQ.  1)  RAOl(I)  =  TEMP 

IF  (J  .EQ.  2)  RAOZd)  =  TEMP 

IF  (IPHS.EQ.l  .AND.  J.EQ.l)  PHSIQ)  =  0. 

IF  (IPHS.EQ.l  .AliD.  J.Eq.2)  PHS2(I)  =  0. 

20  CONTINUE 
30  CONTINUE 

RETURN 

END 

C  DECK  AINPUT 

SUBROUTINE  AINPUT 

COMMON  /lO/  SYSFIL,POTFIL,COFFIL,LCOFIL.ICARD,TEXFIL,IPRIN, 

2  SCRFIL , HPLFIL , LRAFIL .ORGFIL .RAOFIL . RMSFIL , SEVFIL , SPDFIL . 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL , POTFIL, COFFIL . LCOFIL , ICARD , TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL . RMSFIL , SEVFIL . SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 
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COMMON  /SMPSYS/  FIS , AS , SIS , SOS ,SDS .HALOS . DEV ,PRN , SHPPS , SMPIS , 

2  SMPOS , SMPDS , SHPTYPS .SHIPS , VARS , CYCLS , TITLES . OPTION , LSIS . LSOS , 

2  LSDS , LH ALOS . LD£V , LPRN , LSMPPS , LSMPIS , LSMPOS , LSMPDS , LSHPTYPS , 

2  LSHIPS.LTITLES 
CHARACTER»160  AS 

CHARACTER+80  FIS .SIS , SOS ,SDS .TITLES 

CHARACTER*20  HALOS , DEV . PRN .SMPPS , SMPIS , SMPOS .SMPDS, SHPTYPS 
CHARACTER  SHIPS*6,VARS+2,CYCLS+2 
INTEGERf2  OPTION 

CHARACTER*4  AL1NEC20) 

FIS  =  SIS(1;LSIS)//' .IKP’ 

OPEN  (UNIT=ICARD,FILE=FIS,STATUS= ‘OLD* ) 

L  =  0 

10  L  =  L  +  1 

IF  (MODCL.BO)  .EQ.  1)  WRITE  (IPRIN.IOOO)  (I. 1=1. 8) 

1000  FORMAT  (1H1.42X.21HI  NPUT  CARD  S//SOX . 6HC0LUMK/8X . 

2  8(9X.I1)/8H  CARD  . 8( 10H1234S67890)/) 

READ  (ICARD.lOlO)  ALINE 
WRITE  (IPRIH.1020)  L. ALINE 
1010  FORMAT  (20A4) 

1020  FORMAT  ( IX . 14 . 3X , 20A4) 

IF  (ALINE(l)  .HE.  ‘STOP’)  GO  TO  10 

CLOSE  (UNIT=ICARD) 

RETURN 

END 

C  DECK  ALAG 

FUNCTION  ALAG(X) 

*  this  function  sets  AL0G(X)=0  when  x=0 

IF  (X  .LE.  1.  E-08)  GO  TO  7 
ALAG=ALQG(X) 

GO  TO  8 

7  ALAG=0. 

8  RETURN 
END 

C  DECK  ALGRNG 

SUBROUTINE  ALGRNG  (N,V,S.AREA) 

*  This  subroutine  computes  the  area  under  the  curve  for  a  particular 

*  spectrum.  An  odd  number  of  points  (frequencies)  should  be  used. 


DIMENSION  U(N),S(N} 

MN=N-2 
AREA=0 . 

TEMP  =  0. 

DO  20  M=1.MN,2 
A=W  '2)-W(M) 

B=W(r.+2)-W(M+l) 

c=w(m+i)-w(m) 

PAREA  =  AeA/6.'»(S(M)*(3.*C~A)/(A*C)+S(M+l)eA/(B#C)+ 
2  S(M+2)f(2.*A-3.*C)/(A*B)) 

TEMP  =  PAREA 

IF  (PAREA  .LT.  0.)  TEMP  =  0. 

AREA  =  AREA  +  EMP 
20  CONTINUE 

IF  (M0D(H,2)  .EO.  1)  GO  TO  30 
DELW  =  W(N)  -  W(N-l) 

DELS  =  S(N)  -  S(K--l) 

AREA  =  AREA  +  SCN-l)*nET.U  +  .6+DELS*DELW 
30  CONTINUE 


AREA  =  ABS(AREA) 


RETURN 

END 

C  DECK  AMD 

SUBROUTINE  AMD  (OMEGAE.TELEM.TV.TL) 

*  UNPACKS  ZERO-SPEED  ADDED  MASS  AND  DAMPING  AND  ADDS  FORWARD  SPEED 

*  TERMS 

COMMON  /CH3D/  ISIGMA.SIGMIN ,SIGMAX.V,SINMU,COSMU,WTSl , 

2  IMMIN.IMMAX.IMDEL.LHIH.LMAX 

REAL  SIGMIN , SIGMAX . V , SINMU , COSMU , WTSI (4) 

INTEGER  ISIGMA . IMMIN , IMMAX . IMDEL . LMIN , LMAX 

COMMON  /ENVIOR/  VK , NVK , MU ,NMU .OMEGA .NOMEGA , SIGMA .NSIGHA , SIGWH , 

1  NSIGWH .TMODAL , NTMOD , NRANG , RANG , RLANG , S . NNMU , FRNUM , VFS 
INTEGER  NVK , NMU , NOMEGA , NSIGMA .NSIGWH . NTMOD . NRANG , NNMU (8 ) 

REAL  VK(8)  ,MU(;37,8)  .OMEGAOO)  .SIGMA(IO)  ,SIGWH(4)  .TM0DAL(8)  , 

2  RANG(8) .RLANG(8) ,S(30,8) .FRNUM(8) ,VFS(8) 

COMMON  /PHYSCO/  II,TPI,PI,PIOT. DEGRAD . RADDEG , VKMETR . METRVK . GRAY . 
2  RHO , GNU . RHOS , RHOF . GNUS , GNUF . FTHETR . PUN ITS , REYSCL 

rnMBT  PY  TT 

CHARACTER*4  PUNITS(2) 

REAL  TPI . PI . PIOT .DEGRAD . RADDEG . VKMETR. METRVK . GRAY . RHO , GNU . RHOS , 

1  RHOF. GNUS, GNUF. FTMETR 

COMMON  /STATE/  LAT .VRT .LOADS . ADDRES .SALT. HEAD .EXROLL .BKEEL 
LOGICAL  LAT , VRT , LOADS , ADDRES , SALT , HEAD . EXROLL , BKEEL 

COMPLEX  TELEM(4,9.10) 

COMPLEX  T3D(10) .TV(3,3) .TL(3,3) 

DIMENSION  LDX(6.6) 

DATA  ((LDX(I,J).J=1.6).I=1.6) 


+/ 

1, 

0, 

0. 

0, 

0. 

0, 

+ 

0. 

B. 

0. 

8, 

0. 

9, 

+ 

0, 

0. 

2, 

0. 

4, 

0, 

+ 

0. 

-8, 

0. 

6. 

0, 

10, 

+ 

0, 

0. 

-4, 

0, 

3. 

0, 

0, 

-9. 

0.- 

10. 

0. 

7/ 

DO  20 

L= 

1.10 

T3D(L)  =  (0.0, 0.0) 

20  CONTINUE 

DO  40  L=LNIN.LNAX 
DO  30  K=l,4 

T3D(L)  =  T3D(L)  +  WTSI (K)*TELEM(K, ISIGMA, L) 
30  CONTINUE 
40  CONTINUE 

IF (.NOT. VRT)  GO  TO  3 

DO  1  1=1,3 

IDX=2*I-1 

DO  2  J=l,3 

JDX=2*J-1 

L=LDX(IDX,JDX) 

IF(L.EQ.O)  TV(I,J)=(0. 0,0.0) 

IF(L.GT.O)  TV(I,J)=T3D(L) 

IF(L.LT.O)  TV(I,J)=TV(J,I) 

2  CONTINUE 
1  CONTINUE 

TV(2,3)=TV(2,3)+V*TV(2,2}/(ri*0HEGAE) 

TV(3,2)=TV(3,2)-V*TV(2,2)/(II*DHEGAE) 

TV ( 3 , 3 ) =TV ( 3 , 3 ) +V* V+TV ( 2 , 2 ) /OMEG AE+*2 
IF(.NOT.LAT)  GO  TO  6 

3  CONTINUE 

DO  4  1=1,3 

IDX=2*I 

DO  6  J=1.3 

JDX=2*J 
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L=LDX(IDX,JDX) 

IF(L.Eq.O)  TL(I,J)=(0. 0,0.0) 

IF(L.GT.O)  TL(I, J)=T3D(L) 

IF(L,LT.O)  TL(I,J)=TLCJ,I) 

6  CONTINUE 
4  CONTINUE 

TL(1,3)=TL(1 .3)-VfTL(l.l)/(II*0MEGAE) 
TL(2,3)=TL(2,3)-V*TL(2,1)/(II*QMEGAF.) 
TL(3,1)=TL(3,1)+V*TL(1, 1)/(II*QMEGAE) 
TL(3,2)=TL(3,2WV4TLa,2)/(II»0MEGAE) 
TL(3,3)  =  TLC3.3)  +  V*V*TLa , l)/0HEGAE+*2 
6  CONTINUE 

RETURN 

END 

C  DECK  AMDPRN 

SUBROUTINE  AMDPRN  (PROMG.NPRQMG) 


+  noivdimenBionalizes  and  prints  zero-speed  added  mass  and  dajnping 

COMMON  /ENVIOR/  VK.NVK, MU, NMU, OMEGA, NOHEGA, SIGMA, HSIGMA.SIGUH, 

1  NSIGWH , TMODAL , NTMOD , NRANG , RANG , RLANG . S , NHHU , FRNUM , VFS 
INTEGER  NVK . NMU , NOMEGA . NSIGMA .NSIGWH , NTMOD .NRANG , NNKU(8 ) 

REAL  VK(8) ,MU(37,8) ,0MEGA(30) ,SIGMA(10) ,SIGWH(4) .TM0DAL(8) , 

2  RANG(6) ,RLANG(8) ,S(30,8) ,FRNUM(8) ,VFS(8) 

COMMON  /GEOM/  X , NSTATN ,Y ,2 , NQFSET .LPP .BEAM .DRAFT .LCF , 

1  VCG,GM,DELGM,NEBLA,KPITCn.KROLL,KYAW,KYAWRL,AWP,VCB,FBDX,FBDY, 

2  FBD2.NFREBD,XPT,YPT,ZPT.NPTS,LCB,GML,ASTAT,BSTAT, TITLE, MASS, 

2  DISPLM , IPITCH . IRQLL , lYAW , lYAWRL . CHEAVE.CPITCH, CHEAPI , CROLL , 

2  AREAMX , WSURF .GIRTH . FBDZV .DBLWL . TLCB 

INTEGER  NSTATN . N0FSET(26 ) , NFREBD , NPTS 
CHARACTER*4  T1TLE(20) 

REAL  X(2B),Y(10,2B) .7(10 ,2B) ,FBDZV(8, 10) .LPP. BEAM, DBLWL, TLCB, 

2  DRAFT . LCF , VCG , GM, DELGM , NEBLA ,KPITCH .KROLL.KYAW , KYAWRL , AWP , VCB , 

2  FBDX(10),FBDy(10),FBDZ(10),XPT(10),YPT(10) ,ZPT( 10) ,LCB,GML, 

4  ASTAT(2B) ,BSTAT(25) ,MASS,DISPLM, IPITCH, IR0LL,1YAW, 

6  lYAWRL . CHEAVE , CPITCH , CHEAPI , CROLL , AREAMX , WSURF , GIRTH ( 26) 

COMMON  /lO/  SYSFIL.POTFIL.COFFIL.LCOFIL.ICARD.TEXFIL.IPRIN. 
SCRFIL.HPLFIL,LRAFIL,0RGFIL,RA0FIL,RMSF1L,SEVFIL,SPDFIL, 
SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL , POTFIL , COFFIL , LCOFIL , ICARD , TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL . SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /PHYSCO/  II, TPI, PI ,PIOT. DEGRAD, RADDEG.VKHETR.METRVK, GRAY, 
2  RHO , GNU , RHOS . RHOF , GNUS , GHUF .FTMETR .PUNITS , REYSCL 
COMPI  FX  TT 

CHARACTER*4  '''INITS(2) 

REAL  TPI . Pi . t lOT .DEGRAD , RADDEG , VKMETR , METRVK . GRAY ,RHD . GNU , RHUS , 

1  RHOF, GNUS, GNUF, FTMETR 

COMMON  /STATE/  LAT, YRT, LOADS, ADORES, SALT. HEAD, EXROLL, BKEEL 
LOGICAL  LAT , YRT , LOADS . ADORES , S ALT , HEAD , EXROLL , BKEEL 

COMMON/TELEM/TELEM 
COMPLEX  TELEM(4,9,10) 

DIMENSION  LPWR(10),LDX(10) 

DIMENSION  A(IO) ,B(10.30) 

COMPLEX  T.CDUM 
DIMENSION  PROMG(30) 

DATA  LPWR  /0. 0.2, 1,0, 2, 2, 1,1, 2/ 

DATA  LDX  /I, 3, 6, 9, 2, 4, 6, 7, 8, 10/ 

SRGpL=SQRT(GRAY/LFP) 

LKIn~l 

IF (.NOT. YRT)  LMIH=6 
LMAX=10 
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IF(.NOT.LAT)  LMAX=4 
DO  1  1=1,10 

A(I)=0, 

DO  2  J=1,NPR0MG 
B(1,J)=0. 

2  CONTINUE 
1  CONTINUE 

WRITE  (IPRIN.eOl)  TITLE 
WRITE  (IPRIN,602) 

DO  3  I0MEGA=1 .NPROMG 
DO  4  L=LMIN,LMAX 
LL=LDX(L) 

ASCALE=RHO»NEBLA*LPP**LPWR(L) 

BSCALE=ASCALE*SRGDL 

CALL  CPLVAL  (SIGMA, NSIGMA, TELEM(1, 1, L) ,PROMG(IOMEGA) ,T, 

1  CDUH.IDUM) 

A ( LL ) =REAL (T ) / ( -PROMG ( 1 OHEG  A ) ♦*  2 ) / ASC ALE 
B(LL,IOMEGA)=AIMAG(T)/PROMG(IQMEGA)/BSCALE 
4  CONTINUE 

OMGND=PROHG(IOMEGA)/SRGDL 

WRITE  (IPRIN,604)  OMGND . (A(L) ,L=1 .10) 

3  CONTINUE 

WRITE  (IPRIN,603) 

DO  5  I0MEGA=1 .NPROMG 
OMGND=PRQMG(IOMEGA)/SRGDL 

WRITE  (IPRIN,604)  OMGND , (B(L , IOMEGA) , L=1 , 10) 

6  CONTINUE 

WRITE  (IPRIN.eOB) 

601  FORMAT  ( IHl ,23X , 20A4//42X , 

2  46HZER0-SPEED  ADDED-MASS  AND  DAMPING  COEFFICIENTS//) 

602  FORMAT  ('  NON-DIMENSIONAL  ADDED-MASS*// 

1  ’  SIGMA’,3X,’A(1,1)’,6X,*A(2,2)’,6X,*A(3,3)’,6X,’A(4,4)>,6X, 
1  ’A(5,S)',6X.*A(6,6)>,6X.'A(2.4)*,6X.*A(2.6)*.6X,’A(3,B)’,6X, 
1  'A(4,6)*/) 

603  FORMAT  (/’  NON-DIMENSIONAL  DAMPING'// 

1  *  SIGHA’.3X.’B{1.1)’,6X,*B(2,2)’.6X,*B(3,3)=,6X,'B(4.4)’,6X, 

1  ’B(6,5)'.6X.'B(6.6r .6X.'B(2,4)’.6X.*B(2.6)',6X,'B(3,B)’,6X, 

2  '6(4,6)'/) 

604  FORMAT  (1X,F6.3,1P10E12.4) 

605  FORMAT  (///'  (SIGMA  IS  NON-DIMENSIONAL  FREQUENCY)') 

RETURN 

END 


C  DECK  ATAN2D 

FUNCTION  ATAN2D  (B,A,RADDEG) 

♦  arctangent  lunction  in  degrees  lor  any  quadrant 
DATA  EPS  /l.E-10/ 


IF 

(B 

-EQ.  0.) 

ATAK2D 

=  0 

IF 

(B 

•GT.  0. 

ATAN2D 

=  90 

IF 

(B 

•LT.  0.) 

ATAN2D 

=-90 

IF  (ABS(A)  .GT.  EPS)  ATAN2D  =  ATAN2(B,A)*RADDEG 


RETURN 

END 


C  DECK  ATAN3 

FUNCTION  ATAH3(X,Y) 

*  this  lunction  is  to  take  care  of  the  case  of  ATAN2(0,0) 

AX=ABS(X) 

AY=ABS(Y) 

IF(AX  .LE.l.E-08  .AND. AY  .LE.  1.  E-08)  GO  TO  6 
ATAN3=ATAH2(X,Y) 

GO  TO  10 
£  ATAK3=0. 

10  RETURN 
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END 

C  DECK  BILGEK 

SUBROUTINE  BILGEK  (IBLGK) 


♦  calculates  bilge  keel  damping  using  method  of  KATD 

*  W.  R.  MCCREIGHT,  DTNSRDC 

COMMON  /APPEND/  HBKSET,NBKSTN(2) ,BKIMAG(2) ,BKFS(2) ,BKAS(2) , 

2  BKWD(2) ,BKSTN(10,2) .BKHB(10 ,2) .BKLNTH.BKWDTH , 

2  BKWL(10,2) .BKAN(10.2),NSKSET.SKIMAG(2) .SKFLS(2) ,SKALS(2) , 

2  SKAUS(2) ,SKHB(2),SKFLWL(2) .SKALWL(2) .SKAUWL(2) .NRDSET,RDIMAG(2) , 

2  RDRFS(2) ,RDRAS(2) ,RDRHB(2) .RDRFWL(2) .RDRAULC2K RDTFS (2) ,RDTAS(2) , 
2  RDTHBC2) ,RDTFWL(2) ,RDTAWL(2) ,NSBSET,SBIMAG(2) ,S0BRFS(2) ,SDBRAS(2) 
2,S0BRHB(2) ,S0BRFW(2) ,SDBRAW(2) ,SIERFS(2) ,SIBRAS(2) ,SIBRHB(2) , 

2  SIBRFW(2) ,SIBRAW(2) ,SBTFS(2) .SBTAS(2) ,SBTHB(2) , SBTFWL(2) , 

2  SBTAWL(2) ,NFNSET,FNIMAG(2) .FNRFS(2) ,FNRAS(2) , 

2  FNRHB(2),FNRFWL(2),FNRAWL(2) .FNTFS(2) ,FNTAS(2) ,FHTHB(2) , 

2  FNTFWL(2) ,FNTAWL(2) ,NEXPRD.ENRD0(8) ,ENRDS(8) 

COMMON  /CH3D/  ISIGMA .SIGMIN .SIGMAX .V .SINMU .CQSMU ,WTSI , 

2  IMMIN.IMMAX.IMDEL.LMIN.LMAX 

REAL  SIGMIN .SIGMAX , V .SINMU .COSMU , WTSI(4) 

INTEGER  ISIGMA , IMMIN , IMMAX . IMDEL ,LMIN . LHAX 

COMMON  /ENVIQR/  VK.NVK. MU, NHU, OMEGA. NOMEGA. SIGMA, NSIGMA.SIGWH, 

1  KSIGWH .TMODAL , NTMOD .NRANG , RANG .RLANG ,S ,NNMU .FRNUM ,VFS 
INTEGER  NVK , NMU , NOMEGA . NSIGMA , NSIGWH .NTMOD , NRANG , NNMU (8 ) 

REAL  VK(8) .HU(37,8) ,0MEGA(30) ,SIGMA(10) ,SIGWH(4) ,TM0DAL(8) , 

2  RANG(8) .RLANG(8) .S(30,8) .FRNUH(8) .VFS(8) 

COMMON  /GEOM/  X . NSTATN ,Y ,Z .NOFSET ,LPP .BEAM .DRAFT, LCF , 

1  VCG.GM.DELGM.NEBLA.KPITCH.KROLL.KYAW.KYAWRL.AWP.VCB.FBDX.FBDY, 

2  FBDZ , NFREBD , XPT , YPT , ZPT , NPTS , LCB . GHL , AST AT , BSTAT , TITLE , M ASS , 

2  DISPLM , IPITCH , IRQLL , lYAW , lYAWRL , CHEAVE, CPITCH, CHEAPl . CRQLL , 

2  AREAMX , WSURF , GIRTH . FBDZV .DELWL ,TLCB 

INTEGER  NSTATN , N0FSET(26 ) , NFREBD , NPTS 
CHARACTER*4  TITLE(20) 

REAL  X(2B) ,Y( 10.25) .Z(10  ,26) .FBD2V(8 , 10) .LPP.BEAM .DBLWL.TLCB , 

2  DRAFT , LCF . VCG , GM , DELGM , N EBLA , KP ITCH , KROLL , K YAH , KYAWRL , AHP , VCB , 

2  FBDX(10),FBDY(10) .FBDZ(IO) ,XPT(10) ,YPT(10) .ZPTdO) .LCB.GML, 

4  ASTAT (26 ) , BSTAT (26 ) , MASS .DISPLM , IPITCH , IROLL , I Y AH , 

6  I YAHRL . CHEAVE , CPITCH , CHEAP I , CROLL , AREAMX , WSURF , GIRTH ( 26 ) 

COMMON  /PHYSCO/  I I ,TPI , PI , PIOT , DEGRAD , RADDEG . VKMETR . METRVK , GRAV , 

2  RHO . GNU , RHOS , RHOF , GNUS , GNUF , FTMETR .PUNITS , REYSCL 
COMPLEX  II 

CHARACTER*4  PUHITS(2) 

REAL  TP I , PI , PIOT , DEGRAD , RADDEG , VKMETR , METRVK , GRAV , RHO , GNU , RHOS , 

1  RHOF, GNUS, GNUF,  FTMETR 

COMMON  /RDGEO/  BKLEN,HBKKAX,DLBKEL(25) ,SRBS(26) ,PHIS(26) ,CPS(25) , 

2  BKT(26),RKS(26),SSTR(26) 

COMMON  /RLDBK/  PSUR(25) ,BMK(2S) ,DK(25) ,CAK(26) .HQ.HSPAN.HMNCHD, 

2  HAREA,HXCP,HYCP,HZCP,HGAMMA,HYHAT,HEAR,HLCS,RQ(2) ,RSPAN(2) , 

2  RMNCHD(2) ,RAREA(2) ,RXCP(2) ,RYCP(2) ,RZCP(2) ,RGAMMA(2) ,RYHAT(2) . 

2  REAR(2),RLCS(2),SQ(2).SSPAN(2),SMNCHD(2),SAREA(2),SXCP(2) , 

2  SYCP(2),SZCP(2) ,SGAMMA(2) .SyHAT(2),SEAR(2),SLCS(2),BQ(2) , 

2  BSPAH(2) ,BMNCHD(2) ,BAREA(2) ,BXCP(2) ,BYCP(2) ,BZCP(2) .BGAMHA(2) . 

2  BYHAT(2) ,BEAR(2) ,BLCS(2) ,FQ(2) ,FSPAN(2) ,FMNCHD(2) ,FAREA(2) . 

2  FXCP(2) ,FYCP(2) ,FZCP(2) ,FGAMMA(2) ,FYHAT(2) ,FEAR(2) ,FLCS(2) , 

2  PQ(2,2) ,PSPAN(2,2) ,PMNCHD(2.2) .PAREA(2.2) ,PXCP(2 ,2) ,PYC?(2 ,2) , 

2  PZCP(2.2),PGAMMA(2,2),PYHAT(2,2) ,PEAR(2,2) ,PLCS(2,2) , 

2  STADMP(10),SHPDMP(10,8),ENC0N,WPHI,TPHI,HMELM(A,9),SFELM(4.9.8) . 

2  REELM(4,9,8),PEELM(4,9.8) .FEELM(4 ,9 ,8) ,HEELM(4 , 9 .8) ,BEELM(4.9 ,8) , 
2  ENHM.ENSF(8,8) ,ENRE(e) ,ENPE(8) ,ENFE(8) ,ENHE(8) ,ENBE(8) . 

2  ENEMV(8,8) ,ENRL(8) ,ENPL(8) ,ENFL{8) ,ENHL(8) ,EK3L(8) ,ENb*.(8) . 

2  EHSHP(8.8) ,RELM(4,9) ,ITS(26) ,RD(26) ,EDDy(8.26) ,RGB(26) 

REAL  RDBLK(2692) 

EQUIVALENCE  (PSUR( 1) .RDBLKll)) 
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REAL  K APrA, KG, LAMBDA, LBKEEL 
CHARACTER*4  METER 

EXTERNAL  EXP 

DATA  METER  /'METE'/ 

LBKEEL=BKLEN 
NSM  =  NSTATN  -  1 
DO  40  K=2.NSM 

IF  (NOFSET(K)  .LT.  2)  GO  TO  40 
IF  (DLBKEL(K)  .EQ.  0.)  GO  TO  40 
NNODES  =  NOFSET(K) 

R=RD(K) 

BLOCAL  =  2*BMK(K) 

TLOCAL  =  ABS(BKT(K)) 

KG  =  VCG  +  TLOCAL 
BBKEEL  =  BKWD(IBLGK) 

PHI=PHIS(K) 

COSPHI=CPS(K) 

RK=RKS(K) 

SS  =  SSTR(K) 

SRB=SRES(K) 

RF=SRB*Y{NNODES,K) 

EPS=ATAN(SRB) 

C0=1000,*(1.44+3.8*PHI»'»3) 

KAPPA  =  R*(1.0  +  RF/BL0CAL)»*2  /  SqRT(BL0CAL*KG/2 . ) 
XI=BBKEEL/(RK*PHIf*0 .76) 

AN=1 . 40+2 . 03*EXP(-26 . +XI ) 

ALPHA=2.0-Ah 

CK=1 . 0+3 . 6+EXP (-9 . 0+KAPPA) 

SGM=2 . 0+BBKEEL/LBKEEL 
CN=1.98+EXP(-6.6+SGM) 

Q  =  (0.6*BLQCAL+TAN(PI/4.  -  EPS/2.)  +  RF  -  KG)  ♦  SIN(PI/4.  + 

2  EPS/2.) 

PO  =  KG  -  TLOCAL/3.  -  2.*'RF/3. 

PI  =  0.88* (KG  -  TLOCAL  -  0.64*(BL0CAL/2.  -  (TLOCAL  -  RF)mN( 
2  PI/4.  +  EPS/2.))) 

LAMBDA  «  R/(TLQCAL  -  RF*(BLOCAL  -  2.*R)/BL0CAL) 

FLAMB=1 . 34*SIN (PI*LAMBDA/3 .6)/ 

1  (1.0+0.162*SIN(PI*(LAMBDA-0.9)/1.8)) 

BCIRC  =  COSPHI  +  SS*(Q+P0-(P0-P1)*FLAMB)/(2.*BBKEEL*RK) 
DAKEEL=2 . 0*DLBKEL(K) *BBKEEL 

CON  =  4.0*RH0/(3.0*PI)*CK*CN*BCIRC*DAKEEL*RK**3 
DO  30  IA==1.NRANG 
DO  20  IS=1,NSIGMA 
PEBE  =  TPI/SIGMA(IS) 

F  =  RK*RANG(IA)*PHI**1.7/(PERE*SQRT(BBKEEL)) 

*  F  must  be  in  meters 

IF  (PUKITS(l)  .SE.  METER)  F  =  F*SQRT(FTMETR) 

CS  =  C0*F**(-ALPHA)/(2. 68*1000.0) 

CA  =  1. 

RN  =  (8.*BBKEEL*RK*RANG(IA)  /  (PERE*GNU))  *  REYSCL 
IF  (RN  .GE.  1000.)  GO  TO  17 
ALIORN  =  AL0G(RK)/AL0G(10.) 

CA  =  1.96  -  0.26*AL10RN  +  0.20*SIN(PI*(AL10RN-2.19)/0.64) 

17  CONTINUE 

STADMP(IS)  =  COH*CS*CA*SIGMA(IS)*RANG(IA) 

STADMP(IS)  =  SIGMA(IS)*STADMP(IS) 

SHPDMP(IS,IA)  =  SHPDMP(IS,IA)  +  STADMP(IS) 

20  CONTINUE 
30  CONTINUE 
40  CONTINUE 

RETURN 

END 

C  DECK  BKEDDY _ 

SUBROUiiKc.  dKEDDY 
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COMMON  /APPEND/  NBKSET , NBKSTN (2) , BKIMAG(2) , BKFS (2) , BKAS(2) , 

2  BKWD(2) ,BKSTN(10,2) ,BKHB(10,2) .BKLNTH.BKWDTH, 

2  BKWL(10,2)  ,BKAN(10.2).NSKSET,SKIMAG(2),SKFLS(2),SKALS(2) , 

2  SKAUS(2) ,SKHB(2),SKFLWL'2) ,SKALWL(;2) ,SKAUWL(2) ,NRDSET,RDIMAG(2) . 

2  RDRFS(2) ,RDRAS(2),RDRHB(2) ,RDRFWL(2) ,RDRAWL(2) ,RDTFS(2) ,RDTAS(2) , 
2  RDTHB(2),RDTFWL(2),RDTAWL(2),NSBSET,SBIMAG(2),SOBRFS(2) ,SOBRAS(2) 
2,S0BRHB(2) ,S0BRFWC2) ,S0BRAW(2) ,S1BRFS(2) ,SIBRAS(2) ,SIBRHB(2) , 

2  STBRFW(2) ,SIBRAW(2KSBTFS(2) ,SBTAS(2) ,SBTHB(2) ,SBTFWL(2) , 

2  SBTAWL(2) ,HFNSET.FNIKAG(2) ,FNRFS(2) ,FNRAS(2) , 

2  FNRHB(2),FHRFWL(2),FNRAWL(2),FNTFS(2) .FSTAS(2) ,FNTHB(2), 

2  FNTFWL(2) ,FNTAWL(2) .NEXPRD ,ENRDQ(8) ,ENRDS(8) 

COMMON  /CH3D/  ISIGMA , SIGHIN .SIGMAX ,V .SINMU, COSMU, WTSI . 

2  IMMIN.IMMAX.IHDEL.LMIN.LMAX 

REAL  SIGMIN .SIGMAX .V .SINMU, COSMU, WTSI (4) 

INTEGER  ISIGMA , IMMIN , IMMAX , IMDEL, LMIN ,LMAX 

COMMON  /ENVIQR/  VK.NVK, MU, NMU, OMEGA, NOMEGA. SIGMA, NSIGMA.SIGWH, 

1  NSIGWH , TMODAL . NTMOD , NRANG . RANG , RLANG , S , NNMU , FRHUM , VFS 
INTEGER  NVK, NMU. NOMEGA, NSIGKA, NSIGWH, NTMOD. NRANG. NNMU(8) 

REAL  VK(8) ,MU(37,8) ,0MEQA(30) ,SIGHA( 10) ,SIGWH(4) ,TM0DAL(8) , 

2  RANG(8) ,RLANG(8) ,S(30,8) ,FRNUM(8) ,VFS(8) 

COMMON  /GEOH/  X .NSTATN , Y ,Z .NOFSET.LPP .BEAM .DRAFT ,LCF , 

1  VCG , GM .DELGM . NEBLA .KPITCH .KRQLL ,KYAW .KYAWRL , AWP , VCB , FBDX , FBDY , 

2  FBDZ . NFREBD , XPT . YPT , ZPT , NPTS . LCB , GML , AST AT , BST AT , TITLE .MASS, 

2  DISPLM , IPITCH , IROLL , lYAW , lYAWRL .CHEAVE .CPITCH , CHEAPI , CROLL , 

2  AREAMX . WSURF .GIRTH , FBOZV .DBLWL ,TLCB 

INTEGER  NSTATN , N0FSET(2S ) . NFREBD .NPTS 
CHARACTER+4  TITLE(20) 

REAL  X(2S) ,Y(10.2S) .Z(10,25) .FBDZV (8 , 10) ,LPP , BEAM .DBLWL .TLCB , 

2  DRAFT , LCF , VCG , GH .DELGM . NEBLA .KPITCH .KROLL.KY AW , KYAWRL , AWP . VCB , 

2  FBDX(10),FaDY(10).FBDZ(lO) .XPT(IO) ,YPT(10) .ZPT( 10) ,LCB ,GML , 

4  ASTAT(26) ,BSTAT(25) .MASS, DISPLM, IPITCH. IROLL, lYAW, 

5  I YAWRL , CHEAVE , CPITCH , CHEAPI , CROLL , AREAMX , WSURF , GIRTH (25 ) 

COMMON  /RLDBK/  PSUR(26) ,BMK(25) ,DK(2b) ,CAR(25) .HQ.HSPAN.HKNCHD, 

2  HAREA,BXCP,HYCP.HZCP.HGAMMA,HYHAT,HEAR,HLCS,RQ(2) ,RSPAN(2) , 

2  RKHCHD(2) ,RAREA(2) ,RXCP(2) ,RYCP(2) ,RZCP(2) ,RGAMMA(2) ,RYHAT(2) , 

2  REAR(2) ,RLCS(2) .SQ(2) .SSPAN(2) .SMNCHD(2) ,SAREA(2) ,SXCP(2) , 

2  SYCP(2),S2CP(2),SGAMMA(2) ,SYHAT(2),SEAR(2),SLCS(2),BQ(2) , 

2  BSPAN(2) ,BMNCHD(2) ,BAREA(2) .BXCP(2) .BYCP(2) ,BZCP(2) .BGAMMA(2) , 

2  BYHAT(2) .BEAR(2) ,BLCS(2) .FQ(2) ,FSPAN(2) ,FMNCHD(2) ,FAREA(2) . 

2  FXCP(2) ,FYCP(2) ,FZCP(2) ,FGAMMA(2) ,PYHAT(2) ,FEAR(2),FLCS(2) . 

2  PQ(2.2),PSPAH(2,2).PMNCHD(2,2) .PAREA(2,2) ,PXCP(2 ,2) ,PYCP(2 .2) , 

2  PZCP(2,2) .PGAMMA(2,2),PYHAT(2,2),PEAR(2,2),PLCS(2,2) , 

2  STADMP(IO) .SHPDMPdO ,8) .ENCON ,WPHI ,TPHI ,WMELM(4,9) ,SFELM(4 ,9 ,8) , 

2  REELM(4,9,8),PEELM(4,9,8),FEELM(4.9,G),HEELM(4,9,8hBEELM(4,9,8), 
2  EHWM,EHSF(8,8) ,ENRE(0) ,ENPE(8) .ENFE(8) ,ENHE(8) ,ENBE(8) , 

2  ENEMV(8.8) ,ENRL(8) .ENPL(8) .ENFL(8),ENHL(8) .ENSL(8) ,ENBL(8) , 

2  ENSHP(8,8ll,RELM(4,9) ,ITS(26) .RD(26) ,EDDY(8.25) ,RGB(26) 

REAL  RDBLK(2692) 

EQUIVALENCE  (PSUR(l) ,RDBLK(l) ) 

DO  20  IA=1, NRANG 
ENBE(IA)  =  0 
DO  10  IS=1,NSIGMA 
SHPDMP(IS.IA)  =  0 
10  CONTINUE 
20  CONTINUE 

IF  (NBKSET  .EQ.  0)  GO  TO  100 
DO  30  1=1, NBKSET 
CALL  CALRGM(I) 

CALL  BILGEK(I) 

30  CONTINUE 

DO  40  IA=1, NRANG 

CALL  SPFIT  (SIGMA, SHPDMP(1,IA>,BEELM(1,1,1A).NSIGMA) 

ENBE(IA)  =  ENC0N*REVAL(BEELM(1, ISIGMA, lA), WTSI) 

40  CONTINUE 
100  CONTINUE 

RETURN 
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END 


C  DECK  BKLIFT 

SUBROUTINE  BKLIFT 

COMMON  /APPEND/  NBKSET  .NBKSTN (2)  ,BK1MAG('^) . BKFS (2)  , BKAS (2)  , 
BKWD(2) ,BKSTN(10,2) ,BKHB ( 10 , 2) .BKLNTH.BKWDTH , 

BKWL(10,2) ,DKAN(10.2) .NSKSET .SKIHAG(2) .SKFLS(2) ,SKALS(2) , 

SKAUS(2) ,SKHB(2),SKFLWL.(2) .SKALULiC) ,SKAUUL(2) , NRDSET , RDIMAC ( C) , 
RDRFS(2) ,RDRAS(2),RDRHE(2) ,RDRFWL(2) ,RDRAWL(2) . RDTFS (2) ,RDTAS(2) 
RDTHB(2) ,RDTFML(2),RDTAWL(2),NSBSET,SBIMAG(2) ,S0BRFS(2) ,S0BRAS(2) 
,S0BRHB(2) .S0BRFW(2) ,SQBRAW(2) .SIBRFS(2) ,SIBRAS(2) ,SIBRHB(2) , 
SIBRFW(2) ,SIBRAW(2) .SBTFS(2) .SBTAS(2) .SBTHB(2) ,SBTFWL(2) , 
SBTAUL(2) ,NFNSET,FNIMAG(2) ,FNRFS(2) ,FNRAS(2) , 

FNRHB(2) ,FHRFWL(2) ,FNRAWL(2) ,FNTFS(2) ,FNTAS(2) .FNTHB(2) , 

FNTFWL(2) ,FNTAWL(2) , NEXPRD ,ENRD0(8) .EHRDS(8) 

COMMON  /ENVIOR/  VK , NVK , MU , NMU .OMEGA .NOMEGA .SIGMA , NSIGMA ,SIGWH , 

1  NSIGWH.TMODAL.NTMOD.NRAUG.RANG.RLAHG.S.NNHU.FRNUH.VFS 
INTEGER  NVK . NMU .NOMEGA , NSIGMA .NSIGWH .NTMOD . NRANG . NNMU (8 ) 

REAL  VK(8) .MUf37.8) .0MEGA(30) ,SIGMA(10) ,SIGWH(4) .TMODALCB) , 

2  RANG(8) ,RLANG(8),S(30.8) .FRNUM(8) ,VFS(8) 

COMMON  /GEQM/  X . NSTATN . Y . Z .NOFSET .LPP .BEAM .DRAFT .LCF . 

1  VCG , GM , DELGM . NEBLA . KPITCH .KROLL . KYAW .KYAWRL , AWP , VCB , FEDX . FBDY . 

2  FBDZ . NFREBD . XPT . YPT . ZPT . NPTS . LCB , GML . ASTAT , BSTAT .TITLE . MASS . 

2  DISPLM . IPITCH . IRQLL . lYAU , lYAWRL . CHEAVE, CPITCH . CHEAPI , CROLL , 

2  AREAMX.WSURF, GIRTH. FEDZV.DBLWL.TLCB 

INTEGER  NSTATN .N0FSET(25) .NFREBD, NPTS 

REAL  X(26) ,Y(10,25) .2(10.25) ,FBD2V(a,10) , LPP .BEAM .DBLWL ,TLCB , 

2  DRAFT. LCF, VCG, GM, DELGM, NEBLA, KPITCH, KROLL, KYAW. KYAWRL. AWP, VCB, 

2  FBDX(10),FBDY(10) ,FBDZ(10) ,XPT(10) ,YPT(lO) ,ZPT(10) .LCB, GML, 

4  ASTAT(25) .BSTAT(25) ,TITLE(20) .MASS, DISPLM, IPITCH, IROLL.IYAW, 

6  lYAWRL , CHEAVE , CPITCH , CHEAPI , CROLL , AREAMX.WSURF , GIRTH (25 ) 

COMMON  /PHYSCO/  II , TPI , PI , PIOT .DEGRAD , RADDEG , VKMETR , METRVK , GRAY , 

2  RHO , GNU , RKOS , REOF , GNUS , GNUF , FTKETR .PUKITS , REYSCL 
COMPLEX  II 

CHARACTER'*4  PUNITS(2) 

REAL  TP I , P I , P lOT , DEGRAD , RADDEG , VKMETR , METRVK , GRAV , RHO , GNU , RHOS , 

1  RHOF, GNUS, GNUF,  FTMETR 

COMMON  /RLDBK/  PSUR(26) ,BMK(25) ,DK(26) ,CAK(25) .HQ.HSPAN.HMNCHD, 

2  HAREA,HXCP,HYCP,HZCP,HGAMMA.HYHAT,HEAR.HLCS,RQ(2),RSPAN(2), 

2  RMNCHD(2) ,RAREA(2) .RXCP(2) ,RYCP(2) ,RZCP(2) .RGAMMA(2) ,RYHAT(2) , 

2  REAR(2) ,RLCS(2) ,SQ(2) ,SSPAN(2) ,SHNCHD(2) ,SAREA(2) ,SXCP(2) , 

2  SYCP(2),SZCP(2) ,SGAMMA(2),SYHAT(2),SEAR(2),SLCS(2),BQ(2) , 

2  BSPAN(2) ,BMNCHD(2) .BAREA(2) ,BXCP(2) ,BYCP(2/ ,B2CP(2) ,BGAMMA(2) , 

2  BYHATU) .BEAR(2) ,BLCS(2) ,Fq(2) ,FSPAN(2) ,FMNCHD(2) ,FAREA(2) , 

2  FXCP(2) ,FyCP(2) ,FZCP(2) ,FGAMMA(2) ,FYHAT(2) .FEAR(2) ,FLCS(2) , 

2  PQ(2,2) ,PSPAN(2.2) ,PMNCHD(2 ,2) ,PAREA(2 ,2) ,PXCP(2 ,2) ,PyCP(2 ,2) , 

2  PZCP(2,2),PGAMMA(2,2),PYHAT(2.2),PEAR(2,2KPLCS(2,2K 
2  STADKP(i0),SBFDMP(10,8) ,ENC0K,WPHI.TPHI,WMELM(4,9),SFELM(4.9.8) , 

2  REELM(4,9,8) ,PEELM(4.9,8) .FEELM(4,9,B) ,HEELM(4,9 ,8) ,BEELM(4,9 ,8) , 
2  ENWM,ENSF(8,8) .ENRE(8) ,ENPE(8) .ENFE(8) ,ENHE(8) ,ENBE(8) . 

2  ENEMV(8,S) ,ENRL(8) .ENPL(8) ,ENFL(8) ,ENHL(8) ,ENSL(8) ,ENBL(8) , 

2  ENSHP(8,8KRELM(4,9).ITS(25) ,RD(25) ,EDDy(8 ,26) .RGB(2B) 

REAL  RDBLK(2692) 

EQUIVALENCE  (PSUR(l)  ,RDBU(l)) 

REAL  LCS.MCHORD 

IF  (NBKSET  .EQ.  0)  GO  TO  30 
EN  =  0 

STASPC  =  LPP/20 
DO  20  K=l, NBKSET 
HBKS  =  NBKSTH(K) 

XBKF  =  LCB  -  BKFS(K)*STASPC 
XBKA  =  LCB  -  BKAS(K)*STASPC 
M  =  KBKS/2 
IF  (M  .EQ.  0)  H  =  1 
YBK  =  BKHB(M,K) 
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ZBKF  =  BKWL(1,K)  -  (DBLWL+VCG) 

ZBKA  =  BKWL(nBKS,K)  -  (DBLVL+VCG) 

Q  =  2 
SUM  -  0 

DO  10  I=1,NBKS 

SUM  =  SUM  +  BKAN(I,K) 

10  CONTINUE 

GAMMA  =  -  SUM/NBKS 
SPAN  =  BKWD(K) 

MCHORD  =  XBKF  -  XBKA 

*  area 

AREA  =  SPAN*MCHGRD 

*  center  of  pressure 

XCP  =  XBKF  -  0.5*MCH0RD 
YCP  s  YBK  +  O.S^SPAN 
2CP  =  (ZBKF  +  ZBKA)/2 

*  moment  airm 

GAM  =  GAMMA*DEGRAD 

YHAT  =  YCP*COS(GAM)  +  2CP*SIN(GAM) 

*  effective  aspect  ratio 

EAR  =  2*SPAN/MCH0RD 

*  lift  curve  slope 

LCS  1=  (PI/2)-*EAR 
BQ(K)  =  0 
BSPANCKI  =  SPAN 
BMNCBD(k)  =  MCHORD 
BAREA(K)  =  AREA 
BXCP(K)  =  XCP 
BYCP(K)  =  YCP 
BZCP(K)  =  ZCP 
BGAMMA(K)  =  GAMMA 
BYHAT(K)  =  YHAT 
BEAR(K)  =  EAR 
BLCS(K)  ®  LCS 

EN  t  EN  +  q*(RH0/2)*AREA*LCS»YHAT*YHAT*WPHI*ENC0N 
20  CONTINUE 
30  CONTINUE 

DO  40  IV=1,NVK 
ENBL(IV)  =  0 

IF  (HBKSET  .GT.  0)  ENBL(IV)  =  EN*VFS(IV) 

40  CONTINUE 

RETURN 

END 

C  DECK  BMAX 

FUNCTION  BMAX(N,X) 

DIMENSION  X(30) 

A=X(1) 

IF(N.LE.l)  GO  TO  2 
DO  1  1=2, N 

IF(X(I).GT.A)  A=X(I) 

1  CONTINUE 

2  CONTINUE 
BMAX=A 

RETURN 

END 

C  DECK  BRWVSP 

SUBROUTINE  BRWVSP  (NOK,SIGWH,TO,W,S) 
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•  this  routine  calculates  a  BRETSCHNEIDEH  2-paraineter  wave  spectrum 

•  (significant  wave  height,  modal  wave  period) 

•  W.G. MEYERS.  DTNSRDC,  072977 

DIMENSION  W(NOK) .S(NOK) 

EXTERNAL  EXP 

DATA  A,B  /4e7. 0626, 1948.2444/ 

T04  =  T0**4 

•  lor  Pierson-Moskowitz  wave  spectrum 

•  T04  =  68.0936*SIGWH**2 

CONI  =  A*SIGWH**2/T04 

C0N2  =  B/T04 

DO  10  1=1, NOK 

W4  =  W(I)**4 

VS  =  W(I)*W4 

ARG  =  C0N2/W4 

IF  (ARG.GT.60.)  S(1)=0. 

IF  (ARG.GT.50, )  GO  TO  10 
S(I)  =  C0N1/W5*EXP(-ARG) 

10  CONTINUE 

RETURN 

END 

C  DECK  CALRGM 

SUBROUTINE  CALRGM  (IBLGK) 

COMMON  /APPEND/  HBKSET.NBKSTN(2) ,BK1MAG(2) ,BKFS(2) ,BKAS(2) , 

2  BK WD ( 2 ) , BKSTN ( 1 0 , 2 ) , BKH  B ( 1 0 . 2 ) , BKLNTH , BKUDTH , 

2  BKWL(10.2) .BKAK(10.2) .NSKSET,SKIMAG(2) .SKFLS(2) ,SKALS(2) , 

2  SKAUS(2) ,SKHB(2) ,SKFLWL(2) ,SKALWH2) .SKAUWLt2) ,NKUSET,hDlMAG(2) . 

2  RDRFS(2) ,RDRAS(2),RDRHB(2),RDRFWL(2) .RDRAWL(2) .RDTFS(2) ,RDTAS(2), 
2  RDTHB(2) .RDTFWL(2) ,RDTAWL(2),NSBSET,SBIMAG(2) ,S0BRFS(2) ,S0BRAS(2) 
2,S0BRHB(2j ,S0BRFW(2) ,S0BRAW(2) .SIBRFS(2) ,SIBRAS(2) ,SIBRHB(2) , 

2  SIBRFW(2) ,SIBRAW(2^ .SBTFS(2) .SBTAS(2) ,SBTHB(2) ,SBTFWL(2) , 

2  SBTAWL(2),NFNSET,FHIMAG(2).FNRFS(2),FNRAS(2) . 

2  FNRRB(2) ,FNRFWL(2) ,FNRAWL(2) .FNTFS(2) .FNTAS(2) ,FNTHB(2) , 

2  FNTFWL(2) ,FHTAVL(2) ,NEXPRD.ENRD0(8) ,ENRDS(8) 

COMMON  /DATINP/  OPTN .MOTH , BSCFIL, VLACPR.RAOPR, RLDHPR.DISPLMT , 

2  LRAOPR , ADRPR , ORGOPTN . GMNOM , KG , STATH (26 ) , H SOFST ( 26 ) , 

2  NLEWF(25) ,HLFBTH( 10 . 26) .WTRLNE( 10,26) ,BLEWF(26) .TLEWF(25) , 

2  AREALF(26) ,NPTL0C,PTNUMB(10) ,PTHAME,XPTLOC( 10) ,YPrLOC(lO) , 

2  ZPTLOC(10),HBB,FBNUMB(10),FBMAME.XPTFBD(10).YPTFBD(10) , 

2  ZPTFBD(IO) .FBCODEdO) ,FBTYPE,RD0T(10) ,VKDES.FHDES, 

2  STATNM,STATIS 

CHARACTER*4  PTNAHE(8, 10) ,FBNAME(h, lo) ,bTATNM(5) ,FBTYPE(3 , 10) 
INTEGER  OPTK , MOTH , BSCFIL , VLACPR .RAOPR , ADRPR , RLDMPR , FBCODE , 

2  FBNUMB,PTNUMB, ORGOPTN 
REAL  KG 

COMMON  /PHYSCO/  II .TPI ,PI , PIOT, DEGRAD .RADDEG ,VKMETR,METRVK ,GRAV , 

2  RHO , GNU , RHOS , RHOF , GNUS , GNUF , FTMETR , PUN ITS , REYSCL 
COMPLEX  II 

CHARACTER*4  PUNITS(2) 

REAL  TPI , PI , PIOT , DEGRAD , RADDEG , VKMETR , METRVK , GRAY , RHO , GNU . RHOS , 

1  RHOF, GNUS, GNUF, FTMETR 

COMMON  /GEOM/  X .NSTATK ,Y ,Z , NOFSET,LPP . BEAM .DRAFT ,LCF , 

1  VCG,GH,DELGM,NEBLA,KPITCH,KROLL,KYAW,XYAWRL, AWP.VCB.FBDX.FBDY, 

2  FBDZ , HFREBD , XPT , YPT , ZPT , NPTS , LCB , GML . ASTAT , BSTAT , TITLE , MASS , 

2  DISPLM,IPITCH,IROLL,IYAV,IYAURL.CHEAVE,CPITCH,CHEAPI,CROLL. 

2  AREAMX .WSURF , GIRTH , FBDZV ,DBLWL , TLCB 

INTEGER  NSTATH .NOFSET (26) , HFREBD, NPTS 
rwiPirTFR*/  TTTLEi2D) 

REAL  X(26) ,Y( 10,26)  ,Z(10,26) .FBD2V(8 , 10) ,LPP .BEAM .DBLWL .TLCB , 

2  DRAFT , LCF , VCG , GM ,DELGM , NEBLA , KPITCH , KROU, , KY AW , KY AWRL . AWP , VCB , 
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2  FBDXC10),FBDY(10) ,FBDZ(10) ,XPT(10) , Yl'TC 10) , ZFT( 1 0) , LCB , GML , 

4  ASTAT(2B)  ,ESTAT(25)  . MASS  .DISPLK  .  IFITCH  ,  IRllLL  .  1  YAW , 

5  lYAWRL.CHEAVE.CPITCH.CHEAPl ,CR01,L.AREAMX.WSUKF,GIRTH(2S) 

COMMON  /RDGF.O/  BKLEN , VBKMAX ,DLBKEL(26) ,SRBS(25) ,PHIS(25) ,CPS(2&) . 
2  BKT(2S),RKS(25).SSTR(26) 

REAL  LBKEEL 
LBKEEL=0. 

NBKS  =  NBKSTN(IBLGK) 

STASPC  =  LPP/20 
M  =  NSTAFN 
NSH  =  NSTATN  -  1 
DO  1  K=2,KSM 
M  ~  N  ~  1 

IF  (NOFSET(K)  .LT.  2)  GO  TO  1 
DELTAL=0. 

SRB=0. 

PHI=0. 

C0SPHI=1. 

RK=1. 

S=0. 

IF  (STATN(M)  .GT.  BKAS(IBLGK)  .OR.  STATN(H)  .LT.  BKFS(IBLGK)) 

2  GO  TO  6 

IF  (STATN(M+l)  .GT.  BKAS(IBLGK)) 

2  DELTAL  =  (EKAS(IBLGK)  -  STATN (M) ) *STASPC 
IF  (STATN(H-l)  .LT.  BKFSdBLGK)) 

2  DELTAL  =  (STATN(M)  -  BKFS(IBLGK) )*STASPC 
IF  (STATN(M+1)  .LE.  BKAS(IBLGK)) 

2  DELTAL  =  DELTAL  +  (STATN(M+l)  -  STATN(H) ) ♦STASPC/2 
IF  (STATN(M-l)  .GE.  BKFS(IBLGK)) 

2  DELTAL  =  DELTAL  +  (STATN(M)  -  STATN(N-l))*STASPC/2 
NNODES=NOFSET{K) 

DO  10  L=1.NBKS 

IF  (STATN(M)  .KE.  BKSTN(L.IBLGK) )  GO  TO  10 

RO  -  SC)R7(BKUB(L,IDLCK)**2  +  (BKWL(L.IBLGK)  -  (DELWL+VCG))**2) 
ARG  =  BKAN(L.IBLGK)*DEGRAD 

YEKC  =  BKHB(L,1BLGK)  +  0.6'»BKWD(IBLGK)*C0S(ARG) 

ZBKC  =  (BKWL(L.IBLGK)  -  DBLWL)  -  0.5*BKWDCIBLGK)*SIH(ARG) 

RK  =  SqRT(YBKC**2  +  (ZBKC-VCG)**2) 

PI  =  ASIN(-V''G/RO) 

P2  «  ATAN2(VCG  +  DBLVL  -  BKWL(L,IBLGK) ,BKHB(L, IBLGK) ) 

PKI  =  PI  +  P2 
COSPHI  =  COS(ARG  -  P2) 

S=0. 

KKM=»NDDES-1 
DO  3  J=1,NNM 
JS=NK0DES-J+1 

IF  (BKHB(L, IBLGK)  .GE.  Y(JS-1,K))  GO  TO  4 
S=S+SQRT((Y(JS,K)-Y(JS-l.K))*'*2+(Z(JS,K)-Z(JS-l,K))**2) 

3  CONTINUE 

4  CONTINUE 

S  =  S  +  SQRT((Y(JS.K)  -  BKHB(L, IBLGK) )**2  +  (ZCJS.K)  - 
2  (BKWL(L, IBLGK)  -  DBLWL))**2) 

*  lind  tainimun  elope  lor  deadriee  calculation  in  "BILGEK" 

M2  =  JS  -  1 
LS  =  M2  -  1 

SRB  =  (Z(M2,K)  -  Z(LS,K))  /  (Y(H2.K)  -  Y(LS.K)) 

J  =  JS 

DO  130  1=2, H2 
J  =  J  -  1 
JSl  =  J  -  1 

SLOPE  =  {Z(J,K)  -  Z(JS1,K))  /  (Y(J,K)  -  Y(JS1,K)) 

IF  (ELOPE  .EQ.  0.)  CO  TO  140 
IF  (SLOPE  .GT.  SRB)  GO  TO  140 
LS=  JSl 
SRB  =  SLOPE 
130  CONTINUE 

•  extrapolate  slope  to  centerline  to  get  local  dralt 
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♦  (excluding  skeg  offsets) 

340  BKT(K)  =  Z(LS.K)  -  SRB*Y(LS,K) 

IF  (BKT(K)  .LT.  Z(3,K))  BKT(K)  =  Z(l.K) 
LBKEELsLBKEEL+DELTAL 
10  CONTINUE 
6  CONTINUE 

DLBKEL(K)=DELTAL 
SRBS(K)=SRB 
PHIS(K)=PHI 
CPS(K)=C0SPHI 
RKS(K)=^RK 
SSTR(K)=S 
1  CONTINUE 
BKLEN=LBKEEL 

RETURN 

END 

r  nPrtf  rnmup 

SUBROUTINE  CDCOMP  (  N,  NDIM,  A,  UL,  IP  ) 

*  COMPLEX  MATRIX  TRIANGULARI2ATI0N  BY  GAUSSIAN  ELIMINATION. 

•  INPUT... 

•  N  =  ORDER  OF  MATRIX. 

■*  KDIM  =  DECLARED  DIMENSION  OF  ARRAY  A  . 

•  A  =  COMPLEX  MATRIX  TO  BE  TRIANGULARIZED . 

*  OUTPUT . . . 

*  UL(I,J),  I  .LE.  J  =  UPPER  triangular  FACTOR,  U  . 

•  ULCI.Jh  I  -GT.  J  e  MULTIPLIERS  =  LOWER  TRIANGULAR 

*  FACTOR,  I  -  L  . 

•  IP(K),  K  .LT.  K  =  INDEX  OF  K-TH  PIVOT  ROW. 

*  IP(N)  =  (-l)e'*(NUMBER  OF  INTERCHANGES)  OR  0  . 

*  USE  "SOLVE"  XU  uBTaIN  SOLUTION  OF  LINEAR  SYSTEM. 

•  DETERM(  A  )  *  IP(N)*UL(1 , 1 )*UL(2 ,2)* . . . •UL(N , N ) . 

*  IF  IP(N)  =  0.  A  IS  SINGULAR,  SOLVE  WILL  DIVIDE  BY  ZERO. 

•  INTERCHANGES  FINISHED  IN  U,  ONLY  PARTIALY  IN  L  . 

REAL  CABS 
COMPLEX  A,  UL,  T 

INTEGER  K.  NDIM,  IP,  K,  KPl,  M,  I,  J 
DIMENSION  A(NDIM,NDIH) ,  UL(NDIM,ND1M) 

DIMENSION  IP(NDIH) 

DO  1050  1=1,  NDIM 
DO  1000  J  =  1,  NDIM 
UL(J,I)  =  A(J,I) 

1000  CONTINUE 
1050  CONTINUE 

IP(N)  =  1 

DO  1700  K  =  1,  N 

IF  (  K  .Eq.  N  )  GO  TO  1600 

KPl  =  K  +  1 

M  =  X 

DO  1100  I  =  KPl,  N 

IF  (  CABS(  UL(I,K)  )  .GT.  CABS(  UL(M,K)  )  )  M  =  I 
1100  CONTINUE 
IP(K)  =  M 

IF  (  M  .NE.  K  )  IP(N)  =  -IP(N) 

T  =  UL(M.K) 

;iL(M,K)  =  UL(K,K) 

ULCK  K)  “  T 

IF  (’CABS(T)  .Eq.  0.0  )  GO  TO  1600 
DO  1200  I  =  KPl,  N 
UL(I,K)  =  -UL(I,K)/T 
i'>nn  rnNTTNUF. 

DO  1500  J  =  KPl,  N 
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T  =  UL(M,J) 

UL(M.J)  =  ULCK.J) 

UL(K,J)  =  T 

IF  (  CABS(T)  .EQ.  0.0  )  GO  TO  1400 
DO  1300  I  KPl,  N 
UL(I,J)  =  UL(I,J)  +  ULa.K)*T 
1300  COHTINUE 
1400  CONTINUE 
ISOO  CONTINUE 
1600  CONTINUE 

IF  (  CABS(  UU(K,K)  )  .EQ.  0.0  )  IPCN)  =  0 
1700  CONTINUE 
99999  CONTINUE 

RETURN 

END 

C  DECK  CEVAL 

COMPLEX  FUNCTION  CEVAL  (CSPLNE .WEIGHT) 

COMPLEX  CSPLNE(4) 

DIMENSION  WE1GHT(4) 

CEVAL  =  (0. ,0. ) 

DO  10  1=1 ,4 

CEVAL  =  CEVAL  +  WEIGHTCI ) ‘CSELNEd ) 

10  CONTINUE 

RETURN 

END 

C  DECK  CLIP 

SUBROUTINE  CLIP  (LIMIT ,TFN .TFNMOD) 

•  this  routine  imposes  a  limit  on  the  magnitude  ol  a  dimensional 

•  transter  lunction  (surge,  auay  or  yaw  in  quartering  seas) 

•  W.G. MEYERS,  DTNSKUO,  OciiVll 

REAL  LIMIT, MAGN 
COMPLEX  TFN, TFNMOD 
MAGN  =  CABSCTFN) 

IF  (LIMIT. LE.O.  .OR.  MAGN .LE. LIMIT)  GO  TO  10 

•  transler  lunction  clipped 

RATIO  =  LIMIT/MAGN 
TFNMOD  =  RATIOeTFN 
GO  TO  20 
10  CONTINUE 

•  transfer  function  not  clipped 

TFNMOD  =  TFN 
20  COHTINUE 

RETURN 

END 

C  DECK  CMINR 

FUNCTION  CMINR  (ISKIP.AA) 

DIMENSION  AA(3,4) 

SOM=0.0 
DO  1  11=1,4 


1F( 

11. EQ. 

ISKIP) 

GO 

TO  2 

12= 

Il  +  l 

IF( 

12. GT. 

.4) 

12= 

1 

IF( 

12. EQ. 

, ISKIP) 

12= 

=12+1 

IF( 

12. GT. 

.4) 

12= 

1 

13= 

12+1 

TFf 

T3 .GT, 

.4) 

13= 

1 

IF(I3.EQ, 

.ISKIP) 

13= 

=  13+1 
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IF(I3.GT.4)  13=1 

SUM=SUM+AA(1.I1)*(AA(2,I2)*AA(3,I3)-AA(2,I3)*AA(3,I2)) 
CONTINUE 
CONTINUE 
CMINR=SUM 

RETURN 
END 

C  DECK  COFOUT 

SUBROUTINE  COFOUT 


generate  coeliicient  lile  containing  speed-dependsint  added-mass 
and  damping,  exciting  forces  and  KOCHIN  functions 

COMMON  /CH3D/  ISIGMA .SIGMIN .SIGMAX ,V,SINMU,COSMU,WTSI , 

2  IMMIN.IMMAX.IMDEL.LMIN.LMAX 

REAL  SIGMIN. SIGMAX, V.SINMU.COSMU.WTSI (4) 

INTEGER  ISIGMA , IMMIN  ,  IMMAX , IMDEL , LMIN , LMAX 

COMMON  /DATINP/  QPTN ,M0TN  ,BSCFIL,VLACPR,RAOPR,RLDMPR,DISPLMT, 

2  LRAPPR,ADRPR,0RG0PTN.GMN0M,KG,STATB(25) .NS0FST(25) , 

2  NLEWF(25),HLFBTH(10,2B) .WTRLNE(10,25) ,BLEWF(25) .TLEWF(25) , 

2  AREALF(26) ,NPTLOC ,PTNUMB(10) ,PTNAME,XPTL0C(10) ,YPTL0C(10) . 

2  ZPTLOC(IO) ,NBB,FBNUMB(10) ,FBNAHE,XPTFBD(10) .YPTFBDdO) , 

2  ZPTFBD( 10) .FBCODE( 10) ,FBTYPE ,RDOT( 10) , VKDES , FNDES , 

2  STATNM.STATIS 

CHARACTER*4  PTNAME(8 , 10) ,FBNAME(8 , 10) ,STATNM(5) ,FBTYPE(3 , 10) 
INTEGER  OPTN . MOTN , BSCFIL . VLACPR , RAOPR , ADRPR , RLDMPR , FBCODE , 

2  FBNUHB.PTNUMB.ORGQPTN 
REAL  KG 

COMMON  /ENVIOR/  VK.NVK, MU, NMU, OMEGA, NOMEGA, SIGMA, NSIGMA.SIGWH, 

1  KSIGWH , TMODAL , NTMOD , NRANG . RANG , RLANG , S , NNMU , FRNUM , VFS 
INTEGER  NVK , NMU , NOMEGA , NSIGMA , NSIGWH , NTMOD , NRANG , NNMU (8 ) 

REAL  VK(e) .MU(37.8) .nHEGA(30) ,SIGMA(10) ,SIGUU(4) ,TM0DALf8) , 

2  RANG(8) ,RLANG(8) ,S(30,8) ,FRNUM(8) ,VFS(8) 

COMMON  /GEOM/  X,NSTATN,Y,Z,NOFSET,LPP, BEAM, DRAFT, LCF, 

1  VCG , GM , DELGM , NEBLA , KPITCH , KROLL , KYAW , KYAWRL , AWP , VCB , FBDX . FBDY , 

2  FBDZ , NFREBD , XPT , YPT , ZPT , NPTS , LCB , GHL , ASTAT , BSTAT , TITLE , M ASS , 

2  DISPLM , IPITCH , IROLL . lYAW , lYAWRL , CHEAVE .CPITCH, CHEAPI , CRi jLL , 

2  AREAMX , WSURF , GIRTH , FBDZV ,DBLWL , TLCB 

INTEGER  NSTATN,N0FSET(26) , NFREBD, NPTS 
CHARACTER*4  TITLE(20) 

REAL  X(26) ,Y(10,26) ,Z(10,26) ,FBDZV(8 , 10) ,LPP , BEAM ,DBLWL, TLCB , 

2  DRAFT , LCF , VCG , GM, DELGM .NEBLA , KPITCH , KROLL, KYAW , KYAWRL , AWP , VCB , 

2  FBDX(10),FBDY(10),FBDZUO),XPT(10),YPT(10),ZPT(10),LCB.GML, 

4  ASTAT(26) ,BSTAT(26) .MASS, DISPLM, IPITCH, IROLL, lYAW, 

6  lYAWRL . CHEAVE , CPITCH , CHEAPI , CROLL , AREAMX , WSURF , GIRTH ( 2B ) 

COMMON  /lO/  SYSFIL,P0TFIL,C0FFIL.LC0FIL.ICARD,TEXF1L,IPRIN, 

2  SCRFIL , HPLFIL , LR AFIL , ORGFIL , RAOFIL , RMSFIL , SEVFIL . SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL , POTFIL , COFFIL , LCOFIL , IC ARD , TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL .RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /PHYSCO/  II, TPI, PI, PIOT, DEGRAD, RADDEG.VKMETR.METRVK.GRAV, 
2  RHO ,  GNU ,  RHOS ,  RHOF .  GNUS ,  GNUF  .FTMETR , PUNI-^S ,  REYSCL 
COMPLEX  II 

CHARACTER+4  PUNITS(2) 

REAL  TPI , PI , PIOT , DEGRAD , RADDEG , VKMETR , METRVK , GRAV , RHO , GNU , RHOS , 

1  RHOF, GNUS, GNUF, FTMETR 

COMMON  /STATE/  LAT, VRT, LOADS. ADDRES, SALT, HEAD. EXROLL, BKEEL 
LOGICAL  LAT , VRT , LOADS , ADDRES , SALT , HEAD , EXROLL , BKEEL 

COMMON  /STELEM/  STELEM 
COMPLEX  STELEM (4, 9, 260) 

CQMMON/TELEM/TELEM 
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COMPLEX  TELEM(4,9, 10) 

COMMON  /WGHTS/  WTDL.HORM 
REAL  WTDLClO, 25) ,NQRM(4, 10,25) 

COMPLEX  TV(3.3) ,TL(3 .3) .EXCV(3) ,EXCL(3) .HJV(3) ,HJL(3) ,H7 
COMPLEX  STVC3,3) .CDUMC3,3) ,SF3(2S) .SH3(25) 

DIMENSION  SA33(25) ,SB33(25) 

DATA  ISIGO  /O/ 

READ  (SCRFIL)  WTDL.NORM 
REWIND  SCRFIL 
REWIND  COFFIL 
READ  (COFFIL)  TELEM 
DO  300  IV=1,HVK 
V  =  VFS(IV) 

NMU  =  NNMU(IV) 

DO  200  IH=1,NMU 
HDNG  =  MUdH.IV) 

SINMU  ==  SIN(HDNG) 

COSHU  =  COS (HDNG) 

CON  =  V*COSMU/GRAV 

DO  100  IW=1,N0MEGA 

ALPHA  =  GMEGA(IW)*CON 

OMEGAE  =  ABS(0MEGA(IW)*(1. 0-ALPHA)) 

IF  (OMEGAE  .LT.  SIGMA(l))  OMEGAE  =  SIGMA(l) 

WE  =  OMEGAE 
WE2  =  WE*WE 
CALL  FINTSP  (OMEGAE) 

DO  50  K=1,NSTATN 
SA33(K)  =  0. 

SB33(K)  =  0. 

NPT  =  HOFSET(K) 

IF  (NPT  .LT.  2)  GO  TO  60 
M  *  (K-l)*10  +  1 

CALL  AMD  (OMEGAE. STELEM(1,1.M),STV,CDUM) 

SA33(K)  =  REAL(STV(2.2))/(-yE2) 

SB33(K)  =  AIMAG(STV(2,2))/WE 
60  CONTINUE 

CALL  AMD  ( OMEGAE, TELEM. TV. TL) 

IF  (ISIGMA  .NE.  ISIGO)  CALL  RDPELM 
ISIGO  *  ISIGMA 

CALL  EXFOR  (OMEGA(IW) .OMEGAE, EXCV,EXCL,HJV,HJL,H7,SF3,SH3) 
WRITE  (COFFIL)  OMEGAE, TV dL,EXCV.EXCL,HJV,HJL,H7 
IF  (LOADS)  WRITE  (LCOFIL)  (SF3(I) ,SH3(I) ,SA33(I) .SB33(I) ,1=1 , 
2  NSTATN) 

100  CONTINUE 
200  CONTINUE 
300  CONTINUE 

REWIND  COFFIL 

RETURN 

END 

C  DECK  CONIWT 

SUBROUTINE  CONIWT  (W.CELEM.NNDDE) 

SUBROUTINE  TO  GENERATE  WEIGHTS  FOR  INTEGRAL  ALONG  CONTOUR 
f  DEFINED  BY  PARAMETRIC  SPLINE  CURVE 

*  INPUT 

*  CELEM(8,J),J=1,(NN0DE-1)  PARAMETRIC  SPLINE  FIT  TO  HULL 

*  CONTOUR  IN  ENDPOINT-TANGENT  FORMAT- 

f  X(0),Y(0).DK(0),DY(0),X(l).Y(l),DX(l),Dy(l) 

*  OUTPUT 

f  W(J) , J=1.NN0DE  WEIGHTS  SUCH  THAT  INTEGRAL  OF  F.DS  = 

*  SUM  OF  F(J).W(J) 

CCKKOS  /lO/  SYSFIL.PQTFIL. COFFIL  L.rnFTI  .TCARrj.TEXFIL.IPRIN. 

2  SCRFIL , HPLFIL .LRAFIL , ORGFIL , RAOFIL , RMSFIL , SEVFIL , SPDFIL , 
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SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL ,POTFIL,COFFIL,LCOFIL, ICARD .TEXFIL , IPRIN , 

SCRFIL , HPLFIL , LRAFIL .ORGFIL .RAOFIL .RMSFIL , SEVFIL , SPDFIL , 
SPTFIL.LACFIL.LAEFIL 


DIMENSION  CELEM(8,9) ,FELM(4,9) 

DIMENSION  TG(IO) .DLDT(6) 

DIMENSION  A(5,5K  IP(5).W(10) 

DIMENSION  F(10) ,CF(4) ,CD(5) ,CG(8) .CGI(9) 
DIMENSION  X(.4).Y(4)  ,ST0RCD(9,6) 
DIMENSION  SCR(3) ,XDS(5) ,YDS(5) ,SUM(6) 


IF  (NNODE.GT. 10) 
IF  (NNODE.GT. 10) 
IF  (NNODE.lt. 2) 
IF  (NNODE.lt. 2) 
602  FORMAT  C  ERROR 
NELEM=NN0DE-1 
DO  1  I=1.NN0DE 
TG(I)=I-1 

1  CONTINUE 

DO  2  1=1,NN0DE 

W(I)=0.0 

2  CONTINUE 


WRITE  (IPRIN, 602)  NNODE 
STOP 

WRITE  (IPRIN, 602)  NNODE 
STOP 

CQNIWT  -  NNODE  =  '.16) 


*  fit  polynomial  to  dl/dt 
set  up  matrices 


DO  3  1=1,5 

T=0.25*(I-1) 

A(I,1)=1.0 
DO  4  J=2,5 
A(I,J)=T*A(I,J-1) 

4  CONTINUE 
3  CONTINUE 

CALL  RDCOMP  (B,6,A,IP) 

IF  (IP(6) .EQ.O)  GO  TO  101 
DO  6  K=1,NELEM 
X(l)=CELEM(l.K) 

XC2j*CELEM(3  K) 

xb)=3.0*(CELEN(6.K)-CELEM(l,K))-2.0*CELEM(3.K)-CELEM(7,K) 
X(4)=CELEM(7 ,K)+CELEM(3,K)+2.0*(CELEMU.K)-CELEM(6,K)) 
Y(1)=CELEM{2,K) 

CELEM(4  K) 

Y(3)=3.0+(CELEM(6,K)-CELEM(2.K))-2.0*CELEH(4,K)-CELEM(8,K) 

Y  U ) =CELEM (8 , K ) +CELEM(4 , K ) +2 . Of (CELEM( 2 , K ) -CELEM ( 6 , K ) ) 
f  evaluate  dl/dt  at  five  points  over  (0,1) 


CALL  PDER  (SCR.IDXD,X.4) 

CALL  PMPY  IXDS.IDXDS.SCR.IDXD.SCR.IDXD) 
CALL  PDER  (SCR,IDYD,Y,4) 

CALL  PMPY  (YDS,IDYDS,SCR.IDYD,SCR,IDYD) 
CALL  PADD  (SUM.IDSUM.XDS.IDXDS.YDS.IDYDS) 
DO  6  1=1,6 

T=0.26f(I-l) 

CALL  PVAL  (TEMP, T, SUM, IDSUM) 
DLDT(I)=SQRT(TEMP) 

6  CONTINUE 


f  fit  polynomial  to  dl/dt 
*  evaluate  matrix  solution 

CALL  RSOLVE  (6,6,A,DLDT,IP) 
DO  7  1=1,6 

STORCD(K,I)=DLDT(I) 

7  CONTINUE 
E  CONTINUE 


f  calculate  Heights 

DO  8  1=1, NNODE 
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DO  9  J=l,NNODE 
F(J)=0.0 
9  CONTINUE 
F(I)=1.0 

CALL  SPFIT  (TG.F.FELH.NNQDE) 

DO  10  J=1,NELEM 
CF(1)=FELM(1,J) 

CF(2)=(FELM(3, J)-FELM(1, J)-FELM(2, J)/3.-FELM(4,J)/6.) 
CF(3j=FELM(2,J)/2. 

CFU)  =  (FELM(4.J)-FELM(2,  J))/6. 

DO  11  K=l,6 

CD(K)=STORCD(J,K) 

11  CONTINUE 

CALL  PMPY  (CG.IDG,CD.B.CF.4) 

CALL  PINT  (CGI.IDGI.CG.IDG) 

CALL  PVAL  (VAL0,0.0,CGI,IDGI) 

CALL  PVAL  (VALI.I.O.CGI.IDGI) 

W(I)=W(I)+VAL1-VAL0 
10  CONTINUE 
8  CONTINUE 

RETURN 

101  CONTINUE 

WRITE  (IPRIN.eOl)  IP(6) 

STOP 

601  FORMAT  ('  ERROR  -  CONIWT  -  IP(S)  =  *.15) 

END 

C  DECK  CPFIT 

SUBROUTINE  CPFIT  (X,  Z,  CELEMS,  NPTS) 

*  CPFIT  CREATED  FROM  SPFIT  E  N  HUBBLE  JUNE  1977 

*  FITS  CUBIC  NON-PARAMETRIC  SPLINE  SEGMENTS 

* 

*  INPUTS 

*  X 

*  z 

*  NPTS 

*  RETURN 

*  CELEMS  =  ARRAY  OF  (NPTS-1)  SEGMENTS  IN  FOLLOWING  FORM 

*  (  (Z(I),  D(I),  Z(I+1),  D(I+1)  )  ,  WHERE 

*  D  =  ARRAY  OF  SECOND  DERIVATIVES  AT  DATA  POINTS 

*  ARRAYS  A,B,C  ARE  MAINLY  SUB  DIAG.,  DIAGONAL,  AND  SUPER  DIAG. 

*  D  ARRAY  IS  THE  RIGHT  BAND  SIDE  OF  MATRIX  EQUATION 

*  SECOND  DERIVATIVES  AT  NODES  ARE  PLACED  IN  D  ARRAY  AFTER  SOLUTION 

*  SOLUTION  TECHNIQUE  IS  GAUSSIAN  ELIMINATION 

*  BOUNDARY  CONDITIONS  SET  BY  EXTRAPOLATION  OF  SECOND  DERIVATIVES 

COMMON  /lO/  SYSFIL.POTFIL.COFFIL.LCOFIL.ICARD.TEXFIL.IPRIN, 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL .RMSFIL , SEVFIL . SPDFIL . 

2  SPTFIL,LACFIL,LAEFIL 

INTEGER  SYSFIL , POTFIL , COFFIL .LCOFIL , ICARD .TEXFIL . IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL .SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMPLEX  Z.  ZDD,  STORE,  D,  CELEMS 
DIMENSION  X(NPTS) .Z(NPTS) ,CELEHS(4,NPTS) 

DIMENSION  AClOO),  B(IOO),  C(IOO),  D(IOO) 

N  =  NPTS 
NLl  =  N  -  1 
NL2  =  N  -  2 
DO  50  1=2, N 

IF  (X(I)_.GT.  X(I-l))  GO  TO  60 
WkI'iE  (IkRj.H,6SS)  X(I-1),X(I) 

GO  TO  88888 
SO  CONTINUE 


TO  SET  OF  COMPLEX  DATA  POINTS 


=  ARRAY  OF  REAL  INDEPENDENT  VARIABLES 
=  ARRAY  OF  COMPLEX  DEPENDENT  VARIABLES 
-  NUMBER  OF  (X,Z)  DATA  POINTS 
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IF  (N  .LE,  100)  GO  TO  100 
WRITE  (IPRIN,999) 

N  =  100 

100  CONTINUE 

IF  (N  .GT.  2)  GO  TO  125 

D(l)  =  (0.0,  0.0) 

D(2)  -  (0.0,  0.0) 

GO  TO  376 
125  CONTINUE 

IF  (N  .GT.  3)  GO  TO  150 

ZDD  =  2.*((X(3)-X(2))*Z(1)+(X(2)-X(1))+Z(3)-(X(3)-X(1))*Z(2)) 
.  /((X(3)-X(2))*(X(2)-X(1))*(X(3)-X(1))) 

D(l)  =  ZDD 
D(2)  =  ZDD 
D(3)  =  ZDD 
GO  TO  376 
160  CONTINUE 

DO  200  1=1, N 
A(I)  =  0.0 
B(I)  =  0.0 
CCI)  =  0.0 
D(I)  =  (0.0,  0.0) 

200  CONTINUE 

*  set  up  matrices  (a  tridiagonal  structure) 

A(l)  =  (X(3)-X(2))/(X(3)-X(1)) 

C(l)  =  2.0 
B(l)  =  1.0  -  A(l) 

D(l)  -  6.0*((2(3)-2(2))/(X(3)-X(2))-(Z(2)-Z(l))/ 

1  (X(2)-X(1)))/(X(3)-X(1)) 

H  =  X(3)  -  X(2) 

DO  260  1=3, NLl 
HP  =  X(I+1)  -  X(I) 

C(I)  =  HP  /  (H+HP) 

B(I)  =  2.0 
A(I)  =  1.0  -  C(I) 

D(I)  =  6.0*((2Cl+l)-Z(I))/HP-(Z(I)-Z(I-l))/H)/(HP+H) 

H  =  HP 

260  CONTINUE 


*  set  boundary  conditions 

C(2)  =  (X(2)-X(1))/(X(3)-X(2)) 

A(2)  =  1.0 

B(2)  =  -1.0-C(2) 

C(2)  =  -A(2)*A(1)/B(1)  +  C(2) 

D(2)  =  (0.0,  0.0) 

C(N)  =  (X(N)-X(N-l))/(X(N-l)-X(N-2)) 
A(N)  =  -1.0  -  C(N) 

B(N)  =  1.0 
D(N)  =  (0.0,  0.0) 

*  solve  equations 


II  =  1 

DO  300  1=1, HL2 

11  =  I  +  1 

12  =  I  +  2 

AUGH  =  ABS  (B(I)) 

IF  (AUGH  .LT.  l.OE-06)  GO  TO  276 
CONST  =  A(I1)  /  B(I) 

B(I1)  =  B(I1)  -  C0NST'»C(I) 

D(I1)  =  D(I1)  -  COHST*D(I) 

IF  (1  .NE.  HL2)  GO  TO  300 


)  -  CO 

J)*C(I 

)  /  B(I) 

)  -  CO 

l)*D(I 

)  /  B(I) 

GO  TO  300 
275  CONTINUE 
I  A  “  I  ^ 

D(I)  =  D(I)  /  C(I) 

D(I1)  =  D(I1)  -  B(I1)*D(I) 
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B(I1)  =  A(I1) 

A(I1)  =  0.0 

D(I2)  =  D(I2)  -  A(I2)*D(I) 

A(I2)  =  0.0 

IF  (I  .NE.  »L2)  GO  TO  300 
A(N)  =  C(N) 

300  CONTINUE 

DET  =  B(NLl)fB(N)  -  C(NL1)*A(N) 

STOKE  “  D(N) 

D(N)  -  (B(NL1)*D(N)  -  D(NL1)*A(N))  /  DET 
D(NLl)  =  tD(NLl)*B(K)  -  C(NL1)*ST0RE)  /  DET 
IP  =  0 

DO  350  1=2, NL2 
JI  =  N  -  I 

IF  gi  .EQ.  IP)  GO  TO  350 
IF  (JI  .EQ.  II)  GO  TO  325 
D(JI)  =  (D(JI)-C(JI)*D(JI+1))/B(JI) 

GO  TO  350 
325  CONTINUE 
IP  =  Jl-1 
STORE  =  D(JI) 

D(JI)  =  D(IP) 

D(IP)  =  (STORE  -  C(IP)+D(JI+1))/B(IP) 

350  CONTINUE 

D(l)  =  (D(l)  -  A(1)»D(3)  -  C(l)+D(2))  /  B(l) 

*  s«t  up  Bpline  segments 

375  CONTINUE 

DO  400  1=1, NLl 
II  =  I  +  1 
CELEMS(1,I)  =  Z(I) 

CELEMS(2,l)  =  D(I) 

CELEMS(3,l)  =  Z(I1) 

CELEMS(4,1)  =  D(Il) 

400  CONTINUE 
99999  CONTINUE 

RETURN 

88888  CONTINUE 
STOP 

888  FORMAT  (’0  CPFIT—  X  VALUES  NOT  ASCENDING',  2E16.8) 

999  FORMAT  (’0  CPFIT—  NPTS  EXCEEDS  100.  ONLY  99  SEGMENTS  RETURNED’) 

END 

C  DECK  CPINTG 

SUBROUTINE  CPINTG  (SXA,SXFI,SX,NPTS,SELEMS,AS,INTGS) 
f  CPINTG  CREATED  FROM  SPINTG 

*  EVALUATES  THE  INTEGRAL  OF  A  COMPLEX  FUNCTION  DEFINED  BY 

*  COMPLEX  NON-PARAMETRIC  SPLINE  SEGMENTS 

*  INPUTS 

*  XA  =  LOWER  LIMIT  OF  INTEGRATION 

*  XB  =  UPPER  LIMIT  OF  INTEGRATION 

*  X  =  ARRAY  OF  REAL  INDEPENDENT  VARIABLES 

*  NPTS  =  NUMBER  OF  VALUES  IN  X-ARRAY 

*  CELEHS  =  NON-PARAMETRIC  SPLINE  SEGMENTS  GENERATED  BY  CPFIT 

*  A  =  CONSTANT  FOR  SPECIFIC  INTEGRAL  TO  BE  EVALUATED 

*  RETURNS 

*  INTG  =  INTEGRAL  OF  F(X)  *  EXP(II*A*X) 

*  IF  A  =  0.0  ,  THEN  INTG  =  INTEGRAL  OF  F(X) 

IMPLICIT  REAL*8(A-H,0-Z) 

COMPLEX  SELEMS , SZA , SZB , SSA ,SSB , IHTGS , CTEMP 
REAL  SXA,SXB,SX,AS 

C0MPLEX*16  CELEMS,  INTG,  II,  CINTG,  SINTG^  CISEG,  SISEG,  SEGINT, 
.  2A,  ZB,  SA,  SB,  Zl,  Z2,  SI,  S2,  ZAA,  ZBD,  iCv.,  FFF ,  COQ 
DIMENSION  X(2B),CELEMS(4,25),SX(NPTS),SELEHS(4,NPTS) 
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EXTERNAL  EXP 

DATA  II  /  (O.D+0,  l.D+0)  / 

CINTG  =  (O.D+0,  O.D+0) 

SINTG  =  vO.D+0,  O.D+0) 

CALL  CPLVAL  (SX,  HPTS,  SELEMS,  SXA ,  S2A,  SSA ,  lA) 

CALL  CPLVAL  (SX,  NPTS ,  SELEMS,  SXB ,  S2B,  SSB,  IB) 
XA=DBLE(SXA) 

XB=DBLE(SXB) 

DO  B  JJ=1.NPTS 
X(JJ)=DBLE(SX(JJ)) 

DO  6  JI=1,4 
CTEMP=SELEMS(ai,JJ) 

6  CELEMSC Jl , JJ)=DCMPLX(DBLE(REAL(CTEMP) ) ,DBLE(AIMAG(CTEHP) ) ) 
5  CONTINUE 

2A=DCHPLX(DBLE(REAL(SZA) ) ,DBLE( AIMAG(S2A) ) ) 
ZB=DCMPLX(DBLE(REAL(SZB) ) ,DBLEUIMAG(SZB) ) ) 
SA=DCMPLX(DBLE(REAL(SSA)) ,DBLE(AIMAG(SSA))) 
SB=DCMPLX(DBLE(REAL(SSB) ) .DBLE(AIMAG(SSB) ) ) 

A  =DBLE(AS) 

A2  =  A  ♦  A 

A3  =  A  *  A2 

A4  =  A  ♦  A3 

DO  500  I=IA,IB 

IF  (I  .GT.  lA)  GO  TO  100 

XI  =  XA 

X2  s  X(I+1) 

Z1  B  ZA 

22  »  CELEMS(3,I) 

51  =  SA 

52  =  CELEMS(4,I) 

GO  TO  300 

100  CONTINUE 

IF  (I  .LT.  IB)  CO  TO  200 
XI  =  X(I) 

X2  =  XB 

Z1  =  CELEMSd.l) 

22  =  ZB 

51  =  CELEMS(2,I) 

52  =  SB 
GO  TO  300 

200  CONTINUE 


XI 

s 

X(I) 

X2 

s 

X(I+1) 

Z1 

s: 

CELEMSI 

;i.i 

22 

S 

CELENS 

3,1 

SI 

= 

CELEMS 

2,1 

S2  =  CELEMS(4,I) 

300  CONTINUE 

XX  =  X2  -  XI 

IF  (A  .HE.  0.0)  GO  TO  400 

SEGIST  =  (22+Zl)  *  XX  /  2.  -  (S2+S1)  ♦  XX**3  /  24. 

CINTG  =  CINTG  +  SEGIHT 
GO  TO  BOO 
400  CONTINUE 

ZAA  =  (S2-S1)  /  (XX  *  6.) 

ZBB  =  SI  /  2. 

ZCC  =  (Z2-Z1)  /  XX  -  (S2  +  2. *31)  *  XX  /  6. 

AXX  =  A  •  XX 
E  =DSIN  (AXX) 

F  =DCOS  (AXX) 

XX2  =  XX  ♦  XX 
XX3  =  XX  *  XX2 

P  =  (3.*A2*XX2  -  6.)  /  A4 

q  =  (A2*XX3  -  6.*XX)  /  A3 

AAl  =  F*P  +  EfQ  +  6./A4 
AA2  =  E*P  -  F*q 
PP  =  (2.*XX)  /  A2 
gq  =  (A2*Xi2  -  2.)  /  A3 
BBi  =  F*PP  +  E+qq 
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BB2  =  E*PP  -  F+qq  -  2./A3 

XXA  =  XX  /  A 

CCl  =  (F-l.)/A2  +  E*XXA 

CC2  =  E/A2  -  F+XXA 

DDl  =  E/A 

DD2  -  (l.-F)/A 

AXl  =  A  *  XI 

VV  =DCOS  (AXl) 

UU  =DSIN  (AXl) 

PPP  =  (AAl^ZAA  +  BB1*ZBB  +  CC1*ZCC  +  DD1*Z1) 

qqq  =  (AA2*ZAA  +  BB2*ZBB  +  CC2*ZCC  +  DD2+21) 

siSEG  =  uu+ppp  +  vv*qqQ 

cisEG  =  vv*ppp  ~  uu^qqq 

CINTG  =  CINTG  +  CISEG 
SIKTG  =  SINTG  +  SISEG 
600  CQHTINUE 

IKTG  =  CINTG  +  IlfSINTG 

IHTGS=CHPLX(REAL(INTG) , REAL( AIMAG(IHTG) ) ) 

RETURN 

END 

C  DECK  CPLVAL 

SUBROUTINE  CPLVAL  (X.  KPTS .  CELEMS,  XO,  ZO,  SO,  lELM) 

*  CPLVAL  CREATED  FROM  SPLVAL 

*  EVALUATES  A  COMPLEX  NON-PARAMETRIC  SPLINE 

*  INPUTS 

*  X  =  ARRAY  OF  REAL  INDEPENDENT  VARIABLES 

*  NPTS  =  NUMBER  OF  VALUES  IN  X-ARRAY 

*  CELEMS=  COMPLEX  SPLINE  SEGMENTS  GENERATED  BY  CPFIT 

*  XO  =  X-VALUE  AT  WHICH  SPLINE  IS  TO  BE  EVALUATED 

*  RETURNS 

*  ZQ  =  F(XO)  =  Z-VALUE  EVALUATED  AT  XO 

*  SO  =  SECOND  DERIVATIVE  EVALUATED  AT  XO 

*  lELM  =  INDEX  OF  SPLINE  SEGMENT  CONTAINING  XO 

COMPLEX  CELEMS,  ZO,  Z1 ,  22,  SO,  SI,  S2 
DIMENSION  X{NPTS) ,CELEHS(4,NPTS) 

COMMON  /lO/  SYSFIL,POTFIL,COFFIL,LCOFIL,ICARD,TEXFIL,IPRIN, 
2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL .RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL,LACFIL,LAEFIL 

INTEGER  SYSFIL , POTFIL , COFFIL , LCOFIL , ICARD , TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL,LACFIL,LAEFIL 

N  -  NPTS 

IF  (XO.GE.X(l)  .AND.  XO.LE.X(N))  GO  TO  100 
WRITE  (IPRIN, S99)  XO 
GO  TO  99999 
100  CONTINUE 

DO  200  1=2, N 

IF  (XO  .GT.  X(I))  GO  TO  200 
GO  TO  300 
200  CONTINUE 

300  CONTINUE 

1  =  1-1 

XX  =  X(I+1)  -  X(I) 

XI  =  XO  -  X(l) 

X2  =  X(I+1)  -  XO 
XX6  =  XX  *  XX  /  6.0 
21  =  CELEMSd,!) 

Z2  =  CELEMS(3,l) 

51  =  CELEMS(2.I) 

52  =  CELEMS (4. I) 

ZO  =  (SI  *  X2*+3  +  S2  Xl**3)  /  (6.0  *  XX)  + 

.  (  (Z1  -  S1+XX6)  *  X2  +  (Z2  -  S2*XX6)  •  XI  )  /  XX 
50  =  (SI  X2  +  Z2  ^  XI)  /  XX 
lELM  =  I 
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RETURN 

99999  CONTINUE 
STOP 

999  FORMAT  CO  EXTRAPOLATION  NOT  ALLOWED.  XO  =',  E16.8) 

END 

C  DECK  CSOLVE 

SUBROUTINE  CSOLVE  (  N,  KDIM,  UL,  B,  X,  IP  ) 

*  SOLUTION  OF  COMPLEX  LINEAR  SYSTEM,  A*X  =  B  . 

*  INPUT. . . 

*  N  =  ORDER  OF  MATRIX. 

*  NDIM  =  DECLARED  DIMENSION  OF  ARRAY  UL. 

*  UL  =  TRIANGULARIZED  MATRIX  OBTAINED  FROM  "DECQMP"  . 

*  B  =  COMPLEX  RIGHT  HAND  VECTOR. 

*  IP  =  POVOT  VECTOR  OBTAINED  FROM  "DECOMP" . 

*  DO  NOT  USE  SOLVE  IF  DECQMP  HAS  SET  IP(N)  =  0  . 

*  OUTPUT. . . 

*  X  =  COMPLEX  SOLUTION  VECTOR. 

COMPLEX  UL,  B,  X,  T 

INTEGER  NDIM,  IP,  I,  K,  KB,  KMl,  KPl,  M,  N,  NMl 
DIMENSION  UL(NDIM,NDIM) ,  B(NDIM),  X(NDIM) 

DIMENSION  IP(NDIM) 

DO  1000  K  =  1,  NDIM 
X(K)  =  B(K) 

1000  CONTINUE 

IF  (  N  .EQ.  1  )  GO  TO  1600 
NMl  =  N  -  1 
DO  1200  K  =  1,  NMl 
KPl  =  K  +  1 
M  =  1P(K) 

T  =  X(M) 

X(M)  =  X(K) 

X(K)  =  T 

DO  1100  I  =  KPl,  N 
X(I)  =  X(I)  +  ULCI.K)*! 

1100  CONTINUE 
1200  CONTINUE 

DO  1400  KB  =  1,  SMI 
KMl  =  N  -  KB 
K  =  KMl  +  1 
X(K)  =  X(K)/UL(K.K) 

T  =  -X(K) 

DO  1300  I  =  1.  KMl 
X(I)  =  X(I)  +  UL(I,K)+T 
1300  CONTINUE 
1400  CONTINUE 
1500  CONTINUE 

X(l)  =  X(1)/UL(1,1) 

99999  CONTINUE 

RETURN 

END 

C  DECK  CUBC02 

SUBROUTINE  CUBG02  (SEG,  CC) 

*  CUBC02  CREATED  FROM  CUBCO  (  NAVSEC-N072  )  -  A  M  REED  JULY  1976 

CONVERT  CUBIC  CURVE  SEGMENT  REPRESENTATION  FROM  ENDPOINT-TANGENT 
FORM  AS  GIVEN  IN  THE  ARRAY  SEG  TO  CUBIC  POLYNOMIAL  COEFFICIENTS 
IN  THE  ARRAY  CC.  SET  POLYNOMIAL  COEFFICIENTS  FOR  THE  EVALUATION 
OF  TANGENT  VECTORS  AND  THE  DX  AND  DY  VALUES  IN  ARRAY  CC. 


* 

♦ 


*  INPUT 

+  SEG  =  (  X(l),  Y(l).  DXd).  DYCl).  X(2),  Y(2).  DX(2),  DY(;2)  ) 

*  RETURN 

*  CC  =  (AX,AY,BX,BY,CX,CY,DX,DY.3AX,3AY,2BX.2BY,X2-X1.Y2-Y1) 

DIMENSION  SEG(8),  CC(14) 

DO  1000  I  =  1.  2 
D  =  SEG(I) 

C  =  SEG(I+2) 

DELTA  =  SEG(I+4)  -  D 

A  =  SEG(I+6)  +  C  -  2.0*DELTA 

B  =  DELTA  -  A  -  C 

CC(I)  =  A 

CC(I+2)  =  B 

CCd+4)  =  C 

CC(I+6)  =  D 

CC(l  +  8)  =  3.0*/. 

CC(I+10)  =  2.0*B 
CC(I+12)  =  DELTA 
1000  CONTINUE 

RETURN 

END 


C  DECK  DKUSLH 

SUBROUTINE  DKWSLM  (KR , IC , IM , NPREDH .N , NDATA .DATA , INDXRL. INDXHD , 
HEADNG.HDNG, LINEAR, SYMMET.SPINDX.TOINDX, IP, PROB.NUMH, 

RK,RQLL) 

COMMON  /DATINP/  OPTN ,MOTN ,BSCFIL , VLACPR,RAOPR, RLDMPR ,DISPLHT , 
LRAOPR , ADRPR , ORGOPTN , GMNQM , KG , STATH (25 ) , NSOFST( 25 ) , 
NLEWF(25),HLFBTH(10.2S) .WTRLNE(10,25) ,BLEWF(2S) .TLEWF(26) , 
AREALr(25) ,KrTLCC ,PTNUMfi(10) ,PTNAME,XPTLOC(10^ .YPTLPC(IO) , 
ZPTLOCdO) ,NBB,FBNUMB(10) ,FBNAHE,XPTFBD(10) ,YPTFBD(10) , 
ZPTFBD(IO)  .FBCQDEdO)  ,FBTYPE,RDOTdO)  ,VKDES,FNDES, 
STATNM,STATIS 

CHARACTER*4  PTNAME(8 , 10) ,FBNAME(8 , 10) ,STATNM(5) ,FBTYPE(3, 10) 
INTEGER  OPTN ,MOTN , BSCFIL , VLACPR , RAOPR, ADRPR, RLDMPR, FBCODE , 

2  FBNUMB,PTNUMB, ORGOPTN 

real  kg 


COMMON  /ENVIOR/  VK,NVK, MU. NMU, OMEGA, NOMEGA, SIGMA, NSIGMA,SIGMH, 

1  NSIGWH , TMODAL , NTMOD , NRANG , RANG , RLANG , S , NNMU , FRNUM , VFS 
INTEGER  NVK, NMU, NOMEGA, NSIGMA, NSIGWH, NTMOD. NRANG, NNMU(8) 

REAL  VK(8) ,MU(37,8) ,0MEGA(30) .SIGMAClO) ,SIGWH(4) ,TM0DAL(8) , 

2  RANG(8) ,RLANG(8) ,S(30,8) ,FRNUM(8) ,VFS(8) 


COMMON  /GEOM/  X,HSTATN,Y.Z,NOFSET,LPP, BEAM, DRAFT. LCF, 

1  VCG , GM , DELGM , NEBL A , KPITCH , KROLL , KY AW , KY AWRL , AWP . VCB . FBDX . FBDY , 

2  FBDZ , NFREBD , XPT , YPT , ZPT . NPTS , LCB , GML , ASTAT , BSTAT , TITLE , MASS , 

2  DISPLM , IP ITCH , IROLL , lYAW , I YAWRL . CHEAVE , CPITCH , CHEAPI , CROLL , 

2  AREAMX , WSURF , G IRTH . FBDZV . DBLWL , TLCB 

INTEGER  NSTATN,N0FSET(26) .NFREBD, NPTS 
CHARACTER*4  TITLE(20) 

REAL  X(25) ,Y(10,26),ZdO,26).FBDZV(8,10),LPP,BEAH,DBLWL.TLCB. 

2  DRAFT , LCF , VCG , GM, DELGM , NEBLA , KPITCH . KROLL, KY AW , KY AWRL , AWP , VCB . 
2  FBDXdO),FBDYdO)  ,FBDZ(10)  ,XPTdO)  ,YPTdO)  .ZPT(IO) , LCB, GML. 

4  ASTAT(26) ,BSTAT(26) , MASS, DISPLM, TPITCH, IROLL, lY AW, 

5  I YAWRL. CHEAVE , CPITCH , CHEAPI .CROLL , AREAMX , WSURF , GIRTH ( 25 ) 


COMMON  /INDEX/  PFIDX,LPFIDX,RMIDX,LRHIDX,SVIDX,LSV1DX 

INTEGER  LPFIDX.LRMIDX.LSVIDX 

REAL  PFIDX(236) ,RMIDX(ie3) ,SVIDX(3) 

COMMON  /lO/  SYSFIL,POTFIL,COFFIL,LCOFIL,ICARD,TEXFIL,IPRIN, 
2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL . SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

Integer  5y5FIL,FGTFIL,C0FriL,LCCFIL,ICAP.D,TEXFIL,IPRIN, 
2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL .RMSFIL , SEVFIL .SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 
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COHMDH  /PHYSCO/  II , TPI , PI , PIOT . DEGRAD , R ADDEG , VKMETR , METRVK , GRAV , 
2  RHO . GKU . RHOS , RHOF , GNUS , GNUF , FTMETR , PUNITS , REYSCL 
COMPLEX  II 

CHARACTER'»4  PUNITS(2) 

REAL  TPI, PI, PIOT, DEGRAD, RADDEG, VKMETR, METRVK, GRAV, RHO, GNU, RHOS, 

1  RHOF, GNUS, GNUF, FTMETR 

INTEGER  HEADNG 
REAL  NUMH,NHMAX,NHMIN 
LOGICAL  LINEAR, SYHMET 
CHARACTER* 1  BLANK 
CHARACTER+2  AC(2),AT,AVK 
CHARACTER*3  FBT(3) .PTC  10) 

CHARACTER*4  AC0ND(3,2) . METER, MET, FT, BS, SUN IT 
CHARACTER*110  PARS, SEA 

DIMENSION  RM(8.24) ,RV(8,24) . ROLLC 13 . 64 , 4 ) . DATA (432) , INDXRL(25 ) , 

2  INDXHD(25) ,HEADNG(26) , HDNG (24 ) .SPINDX (9) . 

2  T0INDX(9) ,PR0B(2S,8,8) , NUMK (25,8 , 8) .ELM(4 . 8) 

DIMENSION  PRB(13) ,NHR(13) 

EXTERNAL  EXP 

DATA  FBT/ ' SLM ' . ’ EMG ’ , ’ SBM '  / 

DATA  PT  /’PI ’ , ■P2' , ’P3' , ’PA’ , ’P6* , 'P6’ , ’PY’ , ’Pe’ , ’P9’ . >P10’/ 
DATA  METER, MET, FT  /‘METE’,’  M,  FT.’/ 

DATA  BLANK  /'  '/ 

DATA  AC  /’LC’ , ’SC’/ 

DATA  ACOND  /’ LONG CRES 'TED  ’ , ’SHOR' , ’TORE’ . 'STED'/ 

IF  (FBCODE(IP)  .EQ.  1)  WRITE  (PARS, 3030)  FBT( 1 ) ,PT(IP ) , 

2  XPTFBD(IP)  .YPTFBDdP)  ,ZPTFBD(IP)  ,RDOT(IP) 

3030  FORMAT  (2A3 , 12X ,30HSUMMING  IN  NUMBER  PER  HOUR  AT,4X,6HXFP  =, 

2  F6.2,3X,6HYCL  = ,F7 . 2, 3X ,5H2BL  = ,F7 . 2, 5X,6HRDDT  =,F6.2) 

IF  (FECOPE(IP)  .EQ.  2)  WRITE  (PARS. 3040)  FBT(2) ,PT(IP) , 

2  XPTF3D(IP) .YPTFBD(IP) .ZPTFBD(IP) 

3040  FORMAT  (2A3  12X ,31HEMERGENCE  IN  NUMBER  PER  HOUR  AT,4X,5HXFP  =, 

2  F6.2,3X,6HyCL  =,F7 .2,3X,SHZBL  =.F7.2.16X) 

IF  (FBCODF.(IP)  .EO.  3)  WRITE  (PARS. 3050)  FBT(3)  .PT(IP) , 

2  XPTFBD(IP) .YPTFBDCIP) .ZPTFBD(IP) 

3050  FORMAT  (2A3 , i2X ,33HSUBMERGENCE  IN  NUMBER  PER  HOUR  AT,4X,5HXFP  =. 
2  F6.2,3X,6HYCL  = ,F7 . 2, 3X, 5H2BL  =,F7.2,14X) 

NSPIND  =  KVK  +  I 
NTOIND  =  NTMOD  +  1 
PRIDIR  =  90. 

SECDIR  =  0. 

OR  =  KR  —  1 
DO  300  IS=1,MSIGWH 
CON  =  SIGWH(IS)*STATIS 
K  =  0 

DO  200  IT0=1, NTMOD 
DO  100  IV=1,KVK 
K  =  K  +  1 

SWHMAX  =  .202*TM0DAL(IT0)**2 

IF  (PUNITS(l)  .EQ.  METER)  SWHMAX  =  SWHMAX*FTMETR 
IF  (SIGUH(IS)  .GT.  SWHMAX)  GO  TO  100 

*  rel&tiire  motion 

CALL  FETCH  (JR, IV, ITO, DATA, RMIDX, SPINDX. TOINDX.NDATA.LRMIDX, 

2  NVK, NTMOD, RMSFIL) 

L  =  2*NPREDH 

DO  10  IA=1,N 

DO  10  IH=1,KPREDH 

IF  (IC  .EQ.  1)  TEMP  =  DATA(L+1) 

IF  (IC  .EQ.  2)  TEMP  =  DATA(L+2) 

L  =  L  +  2 

RM(IA,IH)  =  TEMP*COK 
10  CONTINUE 

♦  relative  velocity 
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CALL  FETCH  (KR , IV , ITO .DATA .RMIDX .SPINDX .TOINDX , NDATA .LRMIDX . 
2  HVK.NTMOD.RMSFIL) 

1.  =  2*NrREDH 
DO  16  IA=1,N 
DO  15  IH=1.NPREDH 


IF  I 

dC  .EQ. 

1) 

TEMP 

=  DATA! 

;l+i) 

IF  ( 
L  = 

CIC  .EQ. 
L  +  2 

2) 

TEMP 

=  DATA( 

!l+2) 

RVdA.IH)  =  TEMP+CON 
15  CONTINUE 
NHEAD  =  24 
N1  =  NHEAD  +  1 
DO  80  IH=1,N1 

IF  (IH  .GT.  NPREDH)  GO  TO  70 
LH  =  INDXHD(IH) 

IF  (.NOT.  LINEAR)  GO  TO  20 
RELMOT  =  RM(1 ,IH) 

RELVEL  =  RVCl.IH) 

GO  TO  50 

20  KH  =  INDXRL(IH) 

RLCALC  =  ROLL(KH.K,IS) 

IF  (RLCALC  .GE.  RLANG(l))  GO  TO  30 
RELMOT  =  RMCl.IH) 

RELVEL  =  RVU.IH) 

GO  TO  50 

30  IF  (RLCALC  .LE.  RLANG(NRANG) )  GO  TO  40 
RELMOT  =  RM(NRANG,IH) 

RELVEL  =  RV(NRANG,IH) 

GO  TO  50 

40  CALL  SPFIT  (RLANG.RMd ,IH) .ELM.NRANG) 

CALL  SPLVAL  (RLANG . NRANG , ELM .RLCALC .RELMOT, DUM, lELM) 
CALL  SPFIT  (RLANG. RV(l.lH). ELM. NRANG) 

CALL  SPLVAL  (RLANG .NRANG .ELM .RLCALC, RELVEL, DUM, lELM) 
50  IF  (FBCODE(IP)  .GT.  l)  GO  TO  60 

*  slsimining 

T  =  FBDZVdV.IP) 

ARG  =  (STATIS*T/RELH0T)**2  /  2 
PROBI  =  0. 

IF  (ARG  .LE.  80.)  PROBI  =  EXP(-ARG) 

ARG  =  (STATIS*RDnT(IP)/RELVEL)**2  /  2 
PROBV  =  0. 

IF  (ARG  .LE.  60.)  PROBV  =  EXP(-ARG) 

PROBS  =  PR0B1*PR0BV 

NUMSLM  =  3600/ (2*PI)  *  (RELVEL/RELMOT)  •  PROBS 
PR0B(LH,IT0,IV)  =  PROBS 
NUMH(LH,ITO,IV)  =  NUMSLM 
GO  TO  80 

*  emergance  and  submerganca 

60  F  =  FBDZVdV.IP) 

ARG  =  (STATIS*F/RELM0T)**2  /  2 
PROBE  =  0. 

IF  (ARG  .LE.  60.)  PROBE  =  EXP(-ARG) 

NUMEMG  =  3600/(2*PI)  *  (hELVEL/RELMCT)  *  PROBE 
PR0B(LH,IT0,IV)  =  PROBE 
NUMH(LH,ITO,IV)  =  NUMEMG 
GO  TO  80 

70  JH  =  INDXRL(IH) 

PROBdH.lTO.IV)  =  PR0B(JH.IT0,IV) 

NUMH(IH,1T0,IV)  =  NUMH(JH,ITO,IV) 

80  CONTINUE 
100  CONTINUE 

IF  (SIGWH(IS)  .GT.  SWEMAX)  GO  TO  200 
KHMAX  =  NUMH(1,IT0,1) 

NHMIN  =  NBMAX 
DO  110  IV=1,NVK 
nn  110  TH=1 .NHEAD 
TEMP  =  NUMBdH.ITO.IV) 

IF  (TEMP  .LT.  NHMIN)  NHMIN  =  TEMP 
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IF  (TEMP  .GT.  NHMAX)  NHMAX  =  TEMP 
110  COKTINUE 

ISIGWH  =  SIGUH(1S)*100 

IF  (ISIGWH  .GE.  1000)  WRITE  (BS,3001)  ISIGWH 

IF  (ISIGWH  .LT.  1000)  WRITE  (B5,3002)  ISIGWH 

IF  (ISIGWH  .LT.  100)  WRITE  (BS,3003)  ISIGWH 

IF  (ISIGWH  .LT.  10)  WRITE  (BS,3004)  ISIGWH 

3001  FORMAT  (H) 

3002  FORMAT  (lHO.13) 

3003  FORMAT  (2HOO.I2) 

3004  FORMAT  (3H000,I1) 

3000  FORMAT  (iHO.Il) 

3010  FORMAT  (12) 

ITMODL  =  TMODAL(ITO)  +  .5 
IF  (ITMODL  .LT.  10)  WRITE  (AT, 3000)  ITMODL 
IF  (ITMODL  .GE.  10)  WRITE  UT,3010)  ITMODL 
SUNIT  =  MET 

IF  (PUNITS(l)  .HE.  METER)  SUKIT  =  FT 

WRITE  (SEA, 3020)  BS . AT , AC ( IC) ,SICWH( IS)  ,SUNIT,TMODAL( ITO) , 

2  (AC0ND(I,IC),1=1,3) ,(STATNM(I),I=1.3) 

3020  FORMAT  (2HBR,A4,2A2,32H  BRETSCHNEIDER  SEAWAY  -  SIGWH  =,F6.2,A4, 

2  lOH  TMODAL  =,F6.2,7H  SEC,  ,3A4,4X,3A4,7X) 

*  WRITE  (SPTFIL,5022)  PARS. SEA 

*  WRITE  (SPTFIL,6026)  NHMIN, NHMAX 
6022  FORMAT  (AllO) 

6026  FORMAT  (1P2E1S.4) 

*  WRITE  (SPDFIL)  ( (NUMH (IH , ITO , IV) , 1V=1 . NVK) , IH= 1 , NHEAD) 

200  CONTINUE 

*  print  number  of  occurrences  in  1  hour  for  slamming,  emergence, 

*  and  submergence 

DO  250  1PAGE=1.2 

IF  (IPAGE.EQ.2  .AND.  SYMMET)  GO  TO  250 
WRITE  (IPRIN.IOOO)  TITLE 
1000  FORMAT  ( lUl ,22X , 20A4) 

IF  (IC  .Eg.  1)  WRITE  (IPRIN.lOlO) 

IF  (IC  .EQ.  2)  WRITE  (IPRIN,1020) 

1010  FORMAT  (/68X,11HL0NGCRESTED) 

1020  FORMAT  (/58X, 12HSH0RTCRESTED) 

IF  (PUNITS(l)  .NE.  METER)  WRITE  (IPRIN,1030)  SIGWH(IS) 

1030  FORMAT  (45X ,26HSIGHIFICANT  WAVE  HEIGHT  =,F6.2,5H  FEET) 

IF  (PUNITS(l)  .Eq.  METER)  WRITE  (IPRIN,103l)  SIGWH(IS) 

1031  FORMAT  (45X .25HSIGNIFICANT  WAVE  HEIGHT  =.F6.2,7H  METERS) 

WRITE  (1PRIK,1032)  (FBNAME(I ,IP) . 1=1 . 6) .XPTFBDC IP) , YPTFBD (IP ) , 

2  ZPTFBD(IP) 

1032  FORMAT  (/33X,6A4.3X,6HXFP  =,F6.2,2X.BHYCL  = ,F7 . 2 ,2X , BHZBL  =,F7.2) 
IF  (FBCODE(IP)  .GT.  1)  GO  TO  120 

WRITE  (IPRIN,1033) 

1033  FORMAT  (/BBX.BKSLAMMING) 

IF  (PUBITS(l)  .EQ.  METER)  WRITE  (IPRIN.1034)  RDOT(IP) 

1034  FORMAT  (43X,20aTaRESH0LD  VELOCITY  =,F6. 2,118  METERS/SEC) 

IF  (PUNITS(l)  .ME.  METER)  WRITE  (IPRIN.1035)  RDOT(IP) 

1035  FORMAT  (43X ,20HTHRESHOLD  VELOCITY  =,F6.2,eH  FEET/SEC) 

120  IF  (FBCODE(IP)  .EQ.  2)  WRITE  (IPRIN,1036) 

1036  FORMAT  (/68X .WHEMERGENCE) 

IF  (FBCODE(IP)  .EQ.  3)  WRITE  (IPRIN.1037) 

1037  FORMAT  (/58X . IIHSUBMERGENCE) 

WRITE  (IPRIN,1040) 

1040  FORMAT  (/43X ,46HPR0BABILITYX100  /NO.  OF  OCCURRENCES  PER  HOUR) 

IF  (IPAGE  .EQ.  2)  GO  TO  226 

*  starboard  headings 

WRITE  (IPRIN,1042)  (HEADNG(IH) , IH=1 . 13) 

1042  FORMAT  (/68X ,29HSH1P  HEADING  ANGLE  IN  DEGREES/4X,1HV,2X,2HT0,7X, 
2  4HHEAD,47X,0HSTBD  BEAM ,46X ,6HF0LL0W/10X , 13(6X , 13) ) 

DO  220  IV=1,NVK 
IVK  =  VK(IV)  +  .6001 
WRITE  (AVK,1046)  IVK 
1045  FORMAT  (12; 

WRITE  (IPRIN.IOSO) 


1050  rORMAT  (IR  ) 

DO  220  1T0=1,NTH0D 

SWHMAX  =  .202*TMQDAL(IT0)**2 

IF  ^FUNITS(l')  .Eq.  METER)  SWHMAX  =  SUHMAX  +  FTMETR 
IF  (.SIGWH(IS)  .GT.  SWHMAX)  GO  TO  220 
IMP  =  THODAL(ITO)  +  .BOOl 
no  210  1H  =  1 . 13 

PRFdH)  =  rR0B(IH,lT0.IV)*100 
RHR(IH)  =  NUMH(IH,1T0,IV) 

210  CONTINUE 

WRITE  (IPRIN,10S2)  AVK , IMP , (PRB (IH) , NHR (IH) , IH= 1 , 13 ) 
1052  FORMAT  (3X , A2 , 2X . 12 , 3X , 1 3(F5 . 1 , IH/ ,  13) ) 

AVK  =  BLANK 
220  CONTINUE 
GO  TO  250 


•  port  haadirgE 

225  WRITE  (IPRIN,1043)  (HEADNG (IH ) . IH=14 . 26) 

1043  FORMAT  ( /S8X . 29HSHIP  HEADING  ANGLE  IN  DEGREES/4X , IHV . 2X , 2HT0 , 7X , 
2  4HHEAD,47X.9HP0RT  BEAM. 46X , 6HFQLL0U/ lOX , 13(6X . 1 3) ) 

DO  240  IV=1,NVK 
IVK  =  VK(TV)  +  .6001 
WRITE  (AVK, 1045)  IVK 
WRITE  (IPRIN.IOBO) 

DO  240  1T0=1 .NTMOD 

SWHMAX  =  .202*TM0DAL(IT0)*»2 

IF  (PUNITS(l)  .EQ.  METER)  SWHMAX  =  SWHMAX*FTHETR 
IF  (SIGWH(IS)  .GT.  SWHMAX)  GO  TO  240 
IMP  =  TMODAL(ITO)  +  .5001 
LH  =  26 

DO  230  1H=1,13 
LH  =  LH  -  1 

PRB(IH)  =  PROB(LH,1TO,1V)*100 
NHR(IH)  «=  KUMH(LH.1T0,IV) 

230  CONTINUE 

WRITE  (IPRIB,1052)  AVK.IMP, (PRB(IH) .NHR(IH) , JH=1 . 13) 

AVK  =  BLANK 
240  CONTINUE 
260  CONTINUE 
300  CONTINUE 

RETURN 

END 

C  DECK  EDMKSP 

FUNCTION  EDMKSP  (WE.LPP.V.EMD) 

REAL  LPP 

EDMKSP  =  EMD/(1  .■*-62E.*(V/(WE*LPP))**2) 

RETURN 

END 

C  DECK  ELTINE  -  computaE  alapaad  tima 
SUBROUTINE  ELTIME  (TS.ES) 


COMMON  /ID/  SYSFIL,P0TFIL,C0FFII..LC0FIL,1CARD.TEXF1L,IPRIN. 
2  SCRFIL.HPLFIL.LRAFIL.ORGFIL.RAOFIL.RMSFIL.SEVFIL.SPDFIL. 

2  SPTFIL,LACFIL,LAEFIL 

INTEGER  SYSFIL , POTFIL, COFFIL .LCOFIL , ICARD . TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL . LRAFIL .ORGFIL , RAOFIL , RMSFIL . SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 


2 

2 

2 


COMMON  /SMPSYS/  FIS , AS , SIS . SOS ,SDS .HALOS .DEV ,FRN , SMPPS . SMPIS . 
SMPOS , SMPDS . SHPTYPS . SHI PS , V ARS . CYCLS . TITLES , OPT! ON . LS IS , LSOS . 
LSDS .LH ALDS . LDEV . LPRN . LSMPPS . LSMPIS . LSMPOS . LSMPDS , LSHPTYPS . 
LSHIPS.LTITLES 
CHARACTER*l60  AS 


CHARACTER*20  HALOS ,DEV , PRN , SMPPS , SMPIS , SMPOS .SMPDS . SHPTYPS 
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K)  to  ro  to  u 


CHARACTEF.  SHIPS+6  ,VARS*2  ,CYCLS*2 
INTEGER*2  OPTION 

CaARACTERf20  TS.ES 

AS  =  ' (I2,1X,I2,1X,FE.2) ■ 

READ  (TS,AS)  IH.IM.BSEC 
READ  (ES.AS)  JH.JM.ESEC 

IF  (ESEC  .GE.  BSEC)  GO  TO  10 
ESEC  =  ESEC  +  60. 

JM  =  JH  -  1 

10  IF  (JM  .GE.  IM)  GO  TO  20 
JM  =  JM  +  60. 

JH  =  JH  -  1 

20  IF  (JH.LT.IH)  JH=JH+24 

KH=JH-IH 

KM=JM-IM 

DELSEC=ESEC-BSEC 

KS=DELSEC+.5 

AS  =  ■ (//29X, "ELAPSED  TIME'7l6X.39C'-")/'// 

2  '17X.13,"  Hours", 2X, 13,  "  Minutes" ,2X, 13,"  Seconds")’ 

WRITE  (•,AS)  KH.KM.KS 
WRITE  (TEXFIL.AS)  KH,KM,KS 

RETURN 

END 

C  DECK  EQHOTN 

SUBROUTINE  EQMOTN 

COMMON  /APPEND/  NBKSET,NBKSTN(2) ,BKIMAG(2) ,BKFS(2) ,BKAS(2) , 

2  BKWD  (  2  )  .  BKSTN  (10 , 2  )  ,  BKHB  ( 1 0 , 2  )  .  BKLNTH ,  BK.WDTH , 

2  BKWL(10,2) ,BKAN(10,2),NSKSET,SKIMAG(2) ,SKFLS(2) .SKALS(2), 

2  SKAUS(2),SKHB(2),SKFLWL(2),SKALWLp),SKAUWL(2),NRDSET,RDIMAG(2), 

2  RDRFS(2) ,RDRAS(2) ,RDRHB(2) ,RDRFWL(2) ,RDRAWL(2) .RDTFS(2) ,RDTAS(2) , 
2  RDTHE(2),RDTFWL(2),RDTAWL(2),NSBSET,SBIMAG(2),S0BBFS(2) .S0BRAS(2) 
2 ,S0BRHB(2) ,S0BRFW(2) ,S0BRAW(2) ,SIBRFS(2) ,SIBRAS(2) ,SIBRHB(2) , 

2  SIBRFW(2) ,SIBRAW(2) ,SBTFS(2) ,SBTAS(2) ,SBTHE(2) ,SBTFWL(2) , 

2  SBTAWL(2) ,NFNSET,FNIMAG(2) ,FNRFS(2) ,FNRAS(2) , 

2  FNRHb(2) ,FNRFWL(2),FNRAWL(2) ,FNTFS(2) ,FNTAS(2) ,FNTHB(2) , 

2  FNTFWL(2),FNTAWL(2) ,NEXPRD,ENRD0(8) ,ENRDS(8) 

COMMON  /CH3D/  ISIGMA,SIGMIN,SIGMAX,V,SINMU,COSMU,WTSI, 

2  IMMIN,IMMAX,IMDEL,LMIN,LMAX 

REAL  SIGMIN,SIGMAX,V,SINMU,C0SMU,WTSI(4) 

INTEGER  ISIGMA , IMMIN  ,IMMAX . IMDEL , LMIN , LMAX 

COMMON  /DATIHP/  OPTN ,MOTN ,BSCFIL,VLACPR,RAOPR,RLDMPR,DlSPLMT, 
LRAOPR , ADRPR , ORGOPTN , GMNOM , KG , STATN(2B) . NSOFST (26 ) , 
NLEWF(26),HLFBTH(10,2E) ,WTRLNE(10 ,25) ,BLEWF(25) ,TLEWF(25) , 
AREALF(26) .NPTLOC ,PTKUMB(10) ,PTNAME,XPTLOC(10) ,YPTLOC(lO) , 
ZPTLOC(IO) ,NBB .FBNUMB(IO) ,FBNAME,XPTFBD(10) ,YPTFBD(10) , 

ZPTFBD ( 10 ) , FBCODE ( 10 ) , FBTYPE , RDOT ( 10 ) , VKDES , FNDES , 

STATKM.STATIS 

CHARACVF.Kf4  PTNAME(8 .10) ,FBNAME(8 , 10) ,STATNM(6) ,FBTYPE(3 , 10) 
INTEGER  OPTN , MOTK , BSCFIL , VLACPR , RAOPR , ADRPR , RLDMPR , FBCODE , 

2  FBNUMB,PTNUMB, ORGOPTN 
REAL  KG 

COMMON  /ENVIOR/  VK . NVK , MU , NMU , OMEGA , NOMEG A , SIGMA . NSIGMA , SIGWH , 

1  NSIGWH . THODAL . N7M0D , NRANG , RANG , RLANG , S , NNhU , FRNUH , VFS 
INTEGER  NVK , NMU , NOMEG A , NSIGMA , NSIGWH , NTMOD , NRANG , NNHU (8) 

REAL  Vi:(8),MU(37,8),0MEGA(3('),SIGMA(10),SIGWH(4),TMDDAL(8) , 

2  RANG(8),RLANG(o).S(30,8) ,FRNUM(8) , VFS(8) 

COMMON  /FINCON/  IACTFN,IFCLCS,FGAIN(8) ,FK(3) ,FA(3) ,FB(3) , 

2  Fv^CS(8,2) 


COMMON  /GEQH/  X,N3TATN,y ,Z,NOFS£T,LPP, BEAM, DRAFT, LCF, 
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1  VCG , GM , DELGM , NEBLft , KPITCH . KROLL , KY  AW ,KY AWRL . AWP . VCB , FBDX , FBDY , 

2  FBDZ , NFREBD , XPT , YPT . ZPT , NPTS ,LCB , GML , ASTAT , PST AT .TITLE , MASS , 

2  DISPLM , IPITCH , IROLL , lYAW , lYAWRL , CHEA''E .CPITCH , CHEAPI , CROLL , 

2  AREAMX.WSURF, GIRTH, FBDZV.DBLWL.TLCB 

INTEGER  NSTATN,N0FSET(25) , NFREBD, KPTS 
CHARACTER*4  TITLE(20) 

REAL  X(25) ,Y(10.25) ,Z(10,25) .FBDZVCB , 10) ,LPP .BEAM .DBLWL .TLCB , 

2  DRAFT , LCF . VCG , GM, DELGM , NEBLA , KP ITCH . KROIL , KY AW , KY AWRL , AWP , VCB , 

2  FBDX(10),FBDY(10) , FBDZ (10) ,XPT(10) ,YPT(10) .ZPT( 10 ) ,LCB , GK.  , 

4  ASTAT(2B)  ,BSTAT(2B)  .MASS .DISPLM , IPITCH , IROLL , lYAU , 

6  lYAWRL , CHEAVE , CPITCH , CHEAPI , CROLL , AREAMX , WSURF , GI RTH (2B ) 

COMMON  /HULL/  A26 

COMMON  /lO/  SYSFIL,POTFIL,CCFFIL,LCOFIL.ICARD,TEXFIL.IPRIN, 

2  SCRFIL,HPLFlL.LRAFIL,ORGFIL,KAOFIL,RMSFiL,SEVFIL,SPDFIL, 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL , POTFIL , CQFFIL , LCGFIL .ICARD , TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL . LRAFIL .ORGFIL . RAQFIL .RMSFIL , SEVFIL . SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /PHYSCO/  II ,TPI .PI ,PIOT .DEGRAD .RADDEG .VKMETR.METRVK , GRAY , 

2  RHO , GNU , RHOS . RHOF , GNUS , GNUF , FTMETR , PUNITS , REYSCL 
COMPLEX  11 

CHARACTER*4  PUNITS(2) 

REAL  TPI , PI , PIQT , DEGRAD , RADDEG , VKMETR .METRVK , GRAY , RHO , GNU , RHOS , 

1  RHOF. GNUS. GNUF. FTMETR 

COMMON  /RLDBK/  PSUR(26) ,BMK(25) .DK(25) ,CAK(25) .HQ .HSPAN , HMNCHD , 

2  HAREA,HXCP,HYCP,H2CP,HGAMHA.HYHAT,HEAR,HLCS,RQ(2) ,RSPAH(2) , 

2  RMNCHD(2) ,RAREA(2) ,RXCP(2) ,RYCP(2) ,RZCP(2) ,RGAMMA(2) .RYHAT(2) , 

2  REAR(2) ,RLCS(2) ,SQ(2) .SSPAN(2) ,SMNCHD(2) ,SAREA(2) ,SXCP(2) , 

2  SYCP(2),S2CP(2) ,SGAMMA(2) ,SYHAT(2),SEAR(2),SLCS(2),BQ(2) , 

2  BSPAN(2) ,BMNCHD(2) ,BAREA(2) ,BXCP(2) ,BYCP(2; ,BZCP(2) ,BGAMMA(2) , 

2  BYHAT(2) ,BEAR(2) ,BLCS(2) ,Fq(2) ,FSPAN(2) ,FMNCHD(2) ,FAREA(2) , 

2  FXCP(2) ,FYCP(2) ,FZCP(2) .FGAMMA(2) ,FYHAT(2) ,FEAR(2) ,FLCS(2) , 

2  PQ(2.2!)  .PSPAK(2.2) ,PMNCHD(2,2) ,PAREA(2.Z),PXCP(2,2),PYCP(2,2) , 

2  P2CP(2,2),PGAMMA(2,2),PYHAT(2,2),PEAR(2,2),PLCS(2,2) , 

2  STADKP(10).SHPDMP(10.8).ENCON.WPKI.TPHI,WHEI.M(4,9),SFELM(4,9,8), 

2  REELM(4,9.8).PEELM(4.9.8).FEELM(4.9,8).HEELM(4,9,8) ,BEELM(4,9,8). 
2  ENWM,ENSF(8,8) ,ENRE<8) ,ENPE(8) .EHFE(8) .ENHE(8) .ENBE(8) . 

2  ENEMV(8,8) ,ENRL(8) .ENPL(8) ,ENFL(8) ,£NHL(8) .ENSL(8) .ENBL(8) , 

2  EHSHP(8,8) ,RELMH,9) ,ITS(26) ,RD(2B) ,EDDY(8.26) ,RGB(2B) 

REAL  RDBLK(2692) 

EQUIVALENCE  (PSUR(l) ,RDBLK(i)) 

COMMON  /SMPSYS/  FIS,AS,SIS.SC-/,SDS,HALOS,DEV,PRN,SMPPS,SHPIS, 

2  SMPOS , SMPDS , SKPTYPS , SHIPS , VARS . CYCLS , TITLES , OPTION , LSIS , LSOS , 

2  LSDS . LHALOS , LDEV . LPRN . LSMPPS .LSMPIS , LSHI’OS , LSMPDS , LSHPTYPS , 

2  LSHIPS.LTITLES 
CHARACTER* 160  AS 

CHARACTER*80  FIS . SIS , SOS , SDS ,TITI ES 

CHARACTER*20  HALOS ,DEV ,PRN .SMPPS , SMPIS, SMPOS , SMPDS, SHPTYPS 
CHARACTER  SH1PS*6,VARS*2,CYCLS*2 
INTEGER*2  OPTION 

COMMON  /STATE/  LAT.VRT, LOADS, ADORES, SALT, HEAP. EXROLL, BKEEL 
LOGICAL  LAT , VRT , LOADS , ADORES , SALT , HEAD , EXLOLL , BKEEL 

COMMON  /TELEH/  TELEM 
COMPLEX  TELEM(4,9.10) 

COMPLEX  TV(;3,3),TL(3,3),EXCV(3),EXCL(3) ,HJV(3,30) .HJL(3,30) , 

2  H7(30) ,TLG(3,3) ,EXCLG(3) ,MOTV(3,30) ,M0TLG(3) ,TLGC(3,3) , 

2  EXCLGC(3) .M0TL(3,30,8) ,UL(5,3) 

COMPLEX  ZER0,TAF(3) .CTEMP 
DIMENSION  T44T(8) 

CHARACTER*4  METER 
REAL  DMEGAE(30) 

INTEGER  IP(3) 

DATA  METER, EPS  / ’METE' ,0 ,001/ 
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*  solve  equations  of  motion 
ZERO  =  (0. ,0.) 

FIS  =  SDS(l;LSDS)/7’ .SCR’ 

OPEN  (UNIT^SCRFIL,FILE=FIS,FORM=’UKFORMATTED’ ,STATUS=’ UNKNOWN’) 
READ  (SCRFIL)  RDBLK 
CLOSE  (UNIT=SCRFIL) 

FIS  =  SDS(i:LSDr>)//’ .COF’ 

OPEN  (UNIT=C0FFIL,F1LE=FIS,F0RM=’UHFQRMATTED’ ,STATUS= ’UNKNOWN’) 
READ  (COFFIL)  TELEM 

FIS  —  SDS ( 1 ’ LSDS ) // *  ORG * 

OPEN  (UNIT=6rGFIL, FILE=FIS,F0RM= ’UNFORMATTED ’ .STATUS^ ’UNKNOWN’) 
FIS  =  SDS(1:L3D3)//’ .LAC’ 

OPEN  (UNIT=LACF.IL,FILE=FIS,  FORM= ’UNFORMATTED ’ ,  STATUS= ’UNKNOWN ’ ) 
FIS  =  SDS(i:LSDS)//’ .LAE’ 

OPEN  (UNIT=LA£FIL,FILE=FIS,  FORM^ ’UNFORMATTED ’ ,  STATU3= ’UNKNOWN ’ ) 
FACT  =  FTMETR 

IF  (PUNITS(l)  .NE.  METER)  FACT  =  1 
NMU  =  13 

VKINC  =  VK(2)  -  VK(1) 

WRITE  (ORGFIL)  TITLE ,NVK , NMU .NOMEGA, OMEGA .NRANG ,RLANG ,VRT ,LAT, 

2  ADDRES , LPP .BEAM  .DRAFT .DISPLM ,GM .DELGM , KG, KROLL ,LCB , GRAV , RHO . 

2  VKDES, VKINC, DBLWL 

DO  300  IV-1,NVK 
V  =  VFS(IV) 

FRNQ  =  FRNUH(IV) 

NMU  =  NNMU(IV) 

DO  200  IH=1,NMU 
HDNG  =  MU(IH,IV) 

SINMU  =  SIN(HDNG) 

COSMU  =  COS (HDNG) 

HDNG  =  HDNG^RADDEG 
ICLIP  =  0 

IF  (ABS(HDNG-EPS)  .LE.  90.)  ICLIP  =  1 

IF  (ICLIP  .EQ.  1)  CALL  LIMIT  (XLIM,YLIM,PSILIM, HDNG, FRNO, DEGRAD, 

2  FACT) 

DO  60  IW  =  1, NOMEG A 

READ  (COFFIL)  OMEGAE(IW) ,TV,TL,EXCV,EXCL, (HJV(I , IW) , 1=1 ,3) , 

2  (HJL(I.IW) ,1=1,3) ,H7(IW) 

WE  =  OMEGAE(IW) 

VE2  =  WE^WE 

A22  =  REAL(TL(i,l))/(-WE2) 

B22  =  AIMAG(TL(1,1))/WE 
A26V  =  REAL(TL(l,3))/(-WE2) 

A26  =  A26V  -  (V/WE2)*B22 
CALL  FINTSP  (OMEGAE(IW)) 

CALL  INERST  (OMEGAE(IW) ,TV,TL) 

IF  (.NOT.  VRT)  GO  TO  10 

CALL  SOLVE  (3,TV,EXCV,M0TV(1 ,IW) ,UL,IP,IPRIN) 

IF  (ICLIP. EQ.l  .AND.  OMEGAE(IW) .LT.0.20) 

2  CALL  CLIP  (XLIM,M0TV(1,IW),M0TV(1,IW)) 

10  IF  (.NOT.  LAT)  GO  TO  60 

IF  (HDNG.GT.EPS  .AND.  ABS(HDNG-180. ) .GT.EPS)  GO  TO  30 
DO  20  J=l,3 
DO  20  IA=1, NRANG 
MOTL(J,IW,IA)  =  (0.0, 0.0) 

20  CONTINUE 
GO  TO  60 

30  CALL  TRNLAT  (VCG,TL,EXCL,TLG,EXCLG) 

CALL  RDEVAL  UV,OMEGA(IW),OMEGAE(IW) , NRANG, TLG.EXCLG.TLGC.EXCLGC, 
2  T44T) 

IF  (lACTFN  .Eg.  0)  GO  TO  34 
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*  add  active  lin  coeflicients 

OMGE  =  OMEGAE(IW) 

0MGE2  =  QMGE*0MGE 

CALL  ACTFIN  (IV.ZER0,V.QMGE.QMGE2.TAF) 

DO  32  1=1,3 

TLGC(I,2)  =  TLGC(I,2)  +  FGAIN(IV)*TAF(1) 

32  CONTINUE 
34  CTEKP  =  TLGC(2,2) 

IF  (IW.EQ.l)  WRITE  (LAEFIL)  VK(IV),HDNG 
WRITE  CLAEFIL)  EXCLGC 

*  IF  (IW.EQ.l)  WRITE  (LAEFIL. 1170)  VK(IV).HDNG 

*  WRITE  (LAEFIL, 1180)  EXCLGC 

*  1170  F0RHAT(8F8.3) 

+  1180  F0RMAT(1P6E13.4) 

IF  (IH.NE.7)  GO  TO  43 

IF  (IW.EQ.l)  WRITE  (LACFIL)  VK(IV) .IlDNG ,RLANG 
WRITE  (LACFIL)  OMEGA(IW) ,OMEGAE(IW) 

WRITE  (LACFIL)  T44T 
DO  37  J=l,3 

37  WRITE  (LACFIL)  (TLGC(I , J) , 1=1 ,3) 

WRITE  (LACFIL)  EXCLGC 
43  CONTINUE 

*  IF  (IW.EQ.l)  WRITE  (LACFIL , 1170)  VK(IV) .HDNG.RLANG 

*  WRITE  (LACFIL. 1170)  OHEGA(IW) ,QMEGAE(IW) 

*  WRITE  (LACFIL, 1180)  T44T 

*  DO  37  J=1.3 

*  37  WRITE  (LACFIL, 1180)  (TLGC(I , J ) ,1=1 ,3) 

*  WRITE  (LACFIL, 1180)  EXCLGC 

»  43  CONTINUE 

*  add  viscous/bilgekoel  eddy  damping 

DO  40  IA=1,NRANG 

TLGC(2,2)  =  CTEMP  +  II*T44T(IA) 

CALL  SOLVE  (3,TLGC.EXCLGC,M0TLG,UL,1P,IPRIN) 

IF  (IH.Eq.7)  WRITE  (LACFIL)  MOTLG 

*  IF  (IH.EQ.7)  WRITE  (LACFIL. 1180)  KOTLG 

CALL  RVSLAT  (VCG, MOTLG, M0TL(1,IW,IA)) 

IF  (ICLIP  .EQ.  0)  GO  TO  40 

IF  (OMEGAE(IW)  .GE.  0.20)  GO  TO  40 

CALL  CLIP  (YLIM,HOTL(1,IW,IA),MOTL(1,IW,IA)) 

CALL  CLIP  (PSILIM,H0TL(3.IW,IA).M0TL(3,IW.IA)) 

40  CONTINUE 
60  CONTINUE 

WRITE  (ORGFIL)  VK(IV) .HDNG.OMEGAE 
IF  (VRT)  WRITE  (ORGFIL)  MOTV 
IF  (LAT)  WRITE  (ORGFIL)  MOTL 
IF  (ADORES)  WRITE  (ORGFIL)  HJV,HJL,H7 
200  CONTINUE 
300  CONTINUE 

CLOSE  (UN1T=C0FFIL) 

CLOSE  (UNIT=ORGFIL) 

CLOSE  (UKIT=LACFIL) 

CLOSE  (UNIT=LAEFIL) 

RETURN 

END 


C  DECK  EXFOR 

SUBRuUTlSE  EXFOR  (OMEGA , OKEGAE.FXV .FXL.HJY ,H JL ,H7 ,F3 ,H,3) 
♦  calculates  exciting  lorces  and  corresponding  loads  data 
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COMMON  /CH3D/  ISIGMA .SIGMIN . SIGMAX , V .SINMU , COSMU , WTSI , 

2  IMMIN,IMMAX,IMDEL,LMIN,LHAX 

REAL  SIGMIN,SIGMAX,V,SIRMU,COSKU,WTSI(4) 

INTEGER  ISIGMA , IMMIN , IMMAX , IMDEL.LMIH ,LMAX 

COMMON  /GEOM/  X.NSTATN.Y.Z.NOFSET.LPP, BEAM, DRAFT, LCF, 

1  VCG , GM , DELGM . NEBLA .KPITCH . KRDLL ,KYAW .KYAWRL , AWP , VCB , FBDX , FBDY , 

2  FBDZ , NFREBD , XPT , YPT , ZPT . NPTS , LCB , GML , ASTAT , BSTAT . TITLE , M ASS , 

2  DISPLM,IPITCH,1ROLL,1YAW,IYAWRL.CHEAVE,CPITCH,CHEAPI.CROLL, 

2  AREAMX , WSURF .GIRTH , FBDZV .DBLUL , TLCB 

INTEGER  NSTATN ,N0FSET(25) .NFREBD, NPTS 
CHARACTER*^  TITLE(20) 

REAL  X(25) ,Y(10.25) ,Z(10,25) .FBDZV(8.10) , LPP, BEAM, DBLWL, TLCB  , 

2  DRAFT , LCF , VCG , GM, DELGM , NEBLA , KPITCH , KROLL , KY AW , KYAWRL . AWP , VCB , 

2  FBDX(10),FBDY(10).FBD2(10) ,XPT(10) ,YPT(10) ,ZPT(10) .LCB, GML, 

4  ASTAT(2B) .BSTAT(25) ,MASS.DISPLM,IPITCH,IRQLL,IYAU. 

6  lYAWRL.CHEAVE.CPITCH.CHEAPI.CRQLL. AREAMX, WSURF, GIRTH(25) 

COMMON  /PELEM/  PELEM 
COMPLEX  PELEM(4,1000) 

COMMON  /PHYSCO/  II ,TPI , PI ,PIOT, DEGRAD , RADDEG .VKMETR .METRVK , GRAV , 
2  RHO , GNU , RHOS ,RHQF , GNUS , GNUF , FTMETR . PUNITS , REYSCL 
COMPLEX  II 

CHARACTER*4  PUNITS(2) 

REAL  TPI . PI . PIOT . DEGRAD , RADUEG , VKMETR , METRVK , GRAV , RHO , GNU , RHOS , 

1  RHOF, GNUS, GNUF, FTMETR 

COMMON  /STATE/  LAT ,VRT .LOADS , ADDRES .SALT, HEAD .EXROLL .BKEEL 
LOGICAL  LAT , VRT , LOADS , ADDRES , SALT , HEAD . FXROLL , BKEEL 

COMMON  /WGHTS/  WTDL.NORM 
REAL  WTDL(10,26) ,N0RM(4,10,2S) 


REAL  NQRM2,N0RM3 
COMPLEX  TEMP 
INTEGER  PSTORE 

COMPLEX  CIV(2S , 3) , C1L(2B , 3 ) , ELEMS (4 . 26 ) 

COMPLEX  CT(3) 

COMPLEX  HTV(26 , 3) , HTL(26 . 3 ) ,HT7 (25) . HT(3) , HT3 , HT2 
COMPLEX  PHI2D(4) ,FXV(3) ,7XL(3) ,HJV(3) ,HJL(3) .H7 
complex  CEP , F3 ( 26 ), H3 ( 26 ), TF3 ,TH3 

EXTERNAL  EXP 


100 

10 


210 


TEST=O.OOB*TPI/LPP 

U  =  ONEGA 

WN  -  U*W/GRAV 

ARGLI  =  -  WN*COSHU 

IF  (ABS(ARGLI)  .LE.  TEST)  ARGLI  = 

PST0RE=1 

DO  1  K=l, NSTATN 
NNODE=NOFSET(K) 

DO  10  1=1,3 

CIL(K.I)=(0. 0,0.0) 

CIV(K,I)=(0. 0,0.0) 

IF  (.NOT.  ADDRES)  GO  TO  100 
HTV(K.I)=(0. ,0. ) 

HTL(K,I)=(0. ,0. ) 


CONTINUE 

CONTINUE 

IF  (.NOT.  LOADS)  GO  TO  210 
F3(K)=(0.,0.) 

H3(K)=(0.,0.) 

CONTINUE 

IF  (ADDRES)  HT7(K)=(0. .0.) 
IF  (NNODE.lt. 2)  GO  TO  1 
DO  2  J=1,NN0DE 
EK2”EXP(HS*Z(  1  ’f''' 

DO  9**"'iM=iMMIN,’ IMMAX, IMDEL 
TEHP=(0. 0,0.0) 


0. 
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DO  19  1=1,4 

TEMP=TEMP+WTSI (I ) fPELEM ( I , PSTORE) 

19  CONTINUE 

PSTORE=PSTORE+l 
PHI2D(IM)=TEMP 
9  CONTINUE 

ARG=WN*Y(J,K)»SINMU 

carg=cos(arg) 

SARG=SIN(ARG) 

NORM2=NORH(2, J.K) 

NQRM3=N0RM(3. J.K) 

IF  (.NOT.  VRT)  GO  TO  3 
T0D=N0RM3+CARG-N0RM2*SINMU*SARG 

CT(l)=EKZ*(GRAV»NORM(l, J,K)+CARG+II*W*TOD*PHI2D(l)) 
CT(2)=EKZ*(GRAV*NQRH3*CARG+IH‘W*TQD*PHI2D(3)) 

IF  {.NOT.  LOADS)  GO  TO  220 

TF3=EKZ*N0RM3t'CARG 

TH3=EKZ+II*T0D*PHI2D(3) 

F3(K)=F3(K)+WTDL(J,K)*TF3 
H3(K)=H3(K)+WTDL(J,K)*TH3 
220  CONTINUE 

IF  (.NOT.  ADDRES)  GO  TO  90 
HT3=-WN*TUD*PHI2D(3) 

HT(l)=(II*WfNORM(l, J,K)*CARG-WN+T0D*PHI2D(1))*EK2 
HT(2)  =  (II*Wt‘N0RM3*CARG+HT3)*EK2 
HT(3)=HT(2)'»X(K)-II*V/0MEGAE*HT3*EKZ 
90  CONTINUE 

CT(3)=-X(K)*CT(2)-W*V/0MEGAE*EKZ*TQD*PHI2D(3) 

DO  4  1=1,3 

CIV(K,I)=CIV(K,1)+WTDL(J,K)*CT(I) 

IF  (ADDRES)  HTV(K,I)=HTV(K.I)+WTDL(J,K)*HT(I) 

4  CONTINUE 

IF  (ADDRES)  HT7(K)=HT7(K)+1I*WN*WTDL(J ,K)*PHI2D(3)*T0D*W/0MEGAE* 

1  EXP(WN*Z(l,K)/2.) 

3  CONTINUE 

IF  (.NOT.  LAT)  GO  TO  C 
TEV=N0RM3*SARG+N0RM2*SINMU*CARG 
CT(1)=EKZ*(-II*GRAV*N0RH2*SARG+W*TEV*PHI2D(2)) 
CT(2)=EKZ*(-II*GRAV*N0RM(4,J,K)+SARG+W*TEV*PHI2D(4)) 

IF  (.NOT.  ADDRES)  GO  TO  30 
HT2=“II*WN*TEV*PHI2D(2) 

HT(i)=(-V*N0RM2*SARG+HT2)*EKZ 

HT(2)=(-W*NQRM(4,J,K)*SARG-II*WN*TEV*PHI2D(4))*EKZ 
HT(3)=HT(l)t-X(K)+II*V/0MEGAE*HT2t‘EKZ 
30  CONTINUE 

CT(3)=X(K)*CT(l)-II*W*V/0MEGAEtTEV*PHI2D(2) 

DO  7  1=1,3 

CIL(K,I)=CIL(K,I)+WTDL(J,K)t‘CT(I) 

IF  (ADDRES)  HTL(K,1)=HTL(K,I)+WTDL(J,K)*HT(I) 

7  CONTINUE 

IF  UDDRES)  HT7(K)=HT7(K)+II*WH*SINMU*WTDL(J,K)*PHI2D(2)*TEV*W* 

2  0MEGAE*EXF(WN<=Z(l,K)/2.) 

6  CONTINUE 

2  CONTINUE 

IF  (.NOT.  LOADS)  GO  TO  230 

♦  sectional  froude-kriloll  "force",  13  w/o  cexp(-ii*k*x*cos(inu) ) 

F3(K)=2*GRAVeF3(K) 

♦  sectional  diffraction  "force"  ,  h3  w/o  cexp(-ii*k*x*cos(mu) ) 

H3(K)=2*W+H3(K) 

230  CONTINUE 
1  CONTINUE 

IF  (.NOT.  VRT)  GO  TO  11 
DO  13  1=1,3 

CALL  CPFIT  (X,CIV(1,I) .ELEMS.NSTATN) 

CALL  CPINTG  (X( 1) .X(NSTATN) ,X ,NSTATN ,ELEMS, ARGLI ,FXV(I) ) 

FXV( I ) =2 . OfRHOfFXV ( 1 ) 

IF  (.NOT.  ADDRES)  GO  TO  130 
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CALL  CPFIT  (X,HTV(1 ,1) ,ELEMS,NSTATK) 

CALL  CPINTG  (X( 1 ) , X(HSTATN ) , X .NSTATN .ELEMS , ARGLI .HJV(l) ) 

130  CONTINUE 

13  CONTINUE 

11  CONTINUE 

IF  (.NOT.  LAT)  GO  TO  12 
DO  14  1  =  1,3 

CALL  CPFIT  (X.CILd , I) ,ELEMS, NSTATN) 

CALL  CPINTG  (X( 1 ). X (NSTATN ), X .NSTATN .ELEMS , ARGLI ,FXL(I ) ) 
FXL(I)=2.0fRH0*FXL(I) 

IF  (.NOT.  ADORES)  GO  TO  140 

CALL  CPFIT  (X.HTLd , I) , ELEMS, NSTATN) 

CALL  CPINTG  (Xd)  ,X(NSTATN)  ,X, NSTATN  .ELEMS  .ARGLI ,  HJL(I)  ) 

140  CONTINUE 

14  CONTINUE 

12  CONTINUE 

IF  (ADORES)  CALL  CPFIT  (X , HT7 .ELEMS . NSTATN) 

IF  (ADORES)  CALL  CPINTG  (X (1 ). X(NSTATN) ,X , NSTATN , ELEMS , 0 ., H7 ) 

RETURN 

END 

C  DECK  EXP 

FUNCTION  EXP(X) 

*  avoid  undarllow  with  F77L  EXP  routine 

IF(X.LT. (-EO))THEN 
EXP=0. 

ELSE 

EXP=DEXP(X) 

ENDIF 

RETURN 

END 

C  DECK  EXPINT 

SUBROUTINE  EXPIHT  (X.Y.E.C.S.KA.RB.CIN.SON) 

*  this  aubroutine  conputes  the  frequency-dependent  part(principal- 

*  value  integral)  of  a  pulsating  source  in  or  below  free  surface 
vhich  can  be  expressed  in  terms  of  exponential  integral. 

DIMENSION  F(6).D(5) 

EXTERNAL  EXP 

DATA  (F(I). 1  =  1, 6)/0. 82176561, 0.39866681. 0.07694245, 

1  0.003611768,0.000023369972/ 

DATA  (D (I ) . 1=1 , 6) /O . 26366032 , 1 .4134031 ,3 . 6964268 , 

1  7.08581,12.640801/ 

DATA  Q,  C-AMM*.  /  3.1415926.535897.  0.67721566490163  / 

DATA  TEST6,TEST6,TEST7, TESTS  /I .E-06, 1 .E-06, 1 .E-07, 1 . E-08/ 

AT=ATAN2(X,Y) 

ARG=AT-0.6+q 
IF(Y.GT.60)  THEN 
E=0. 

ELSE 

E=EXP(-Y) 

ENDIF 

C=COS(X) 

S=SIN(X) 

R=Xee2+Yee2 

AL=0.B*AL0G(R) 

A=-Y 

B=-X 

IF  (A  .GE.  0.0)  GO  TO  78 
IF  (B  .EQ.  0.0)  GO  TO  79 
78  IF  (R  .GE.  100.)  GO  TO  10 
Vy  TtSi  =  TESTS 

IF  (R  .LT.  4.0)  TEST  =  TEST7 
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TEST  =  TEST6 
TEST  =  TESTS 


IF  (R  .LT.  2.0) 

IF  (R  .LT.  1.0) 

SUMC=GAMHA+AL+Y 
SUMS-AT+X 
TC=Y 
TS=X 

DO  1  K=1.B00 
TO=TC 
COX=K 
CAY=K+1 

FACT-C0X/CAY**2 
TC=FACT*CY*TC-X*TS) 

TS=FACT*  C Y*TS+X*TO) 

SUMC=SUMC+TC 
SUMS=SUMS+TS 
IF  (K  .GE.  BOO)  GO  TO  3 
IF  ((ABS(TC)+ABS(TS))  .GT.  TEST)  GO  TO  1 
3  CIN=E*(C*SUMC^S*SUMS) 

SON=E*(S+SUMC-C*SUMS) 

GO  TO  4 
1  CONTINUE 
10  G1=0. 

G2=0. 

DO  20  1=1,6 
DEN=(-Y+D(I))*+2+X**2 
GA=Faj>*(-Y+D(I))/DEN 
GB=F(lW(-X)/DEN 
G1=G1+GA 
20  G2=G2+GB 

CIN=E*q*S-Gl 

SQN=-(E*q*S+G2) 

4  RA=AL-CIN 
RB=ARG+SQN 

RETURN 

END 

C  DECK  FETCH 

SUBROUTINE  FETCH  ( IRESP , I VK . ITO .DATA , RHIDX , SPINDX , TOINDX , NDATA , 

2  LRMIDX.NVK.NTMOD.RMSFIL) 

INTEGER  RMSFIL 

DIMENSION  DATA(NDATA),RMIDX(LRMIDX),SPINDX(NVK+1),TOINDX(NTMOD+1) 

*  cbaiig«  lor  VAX/VHS  version 

e  CDC  CALL  READHS  (RMSFIL, SPINDX, NSPIND, IRESP) 

*  CDC  CALL  STINDX  (RMSFIL, SPINDX, NSPIND) 

*  CDC  CALL  READMS  (RMSFIL. TOINDX, NTOIND.IVK) 

*  CDC  CALL  STINDX  (RMSFIL, TOINDX .NTOIND) 

*  CDC  CALL  READMS  (RMSFIL, DATA, NDATA, ITO) 

*  CDC  CALL  STINDX  (RMSFIL, SPINDX .NSPIND) 

*  CDC  CALL  STINDX  (RMSFIL, RMIDX.LRMIDX) 

INDEX  =  NTMOD  *  NVK  ♦  (IRESP  -  2)  +  NTMOD  •  (IVK  -  1)  +  ITO  +  3 

READ  (RMSFIL. REC=INDEX)  DATA 

RETURN 

END 


C  DECK  FIGIO 

FUNCTION  FIGIO  (GDB) 


*  generates  lunction  ol  ligure  10  ol  TANAKA, 

*  J.  ZOSEN  KIOKAI,  V.  109,  1961 

DIMENSION  GKDB(6) ,RF0RE(6) 


DB(1)=1.2 
DB{2)=1.4 

T\T>  ?  —  4  ^ 

GKDB(4)=1.8 


GKDB 

GKDB 
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#  * 


W 


GKDB(S)=2.0 
GKDB(6)=2.0E 
RF0RE(1)=1 .0 
RF0RE(2)=0,6 
RF0RE(3)=0.34 
RF0RE(4)=0.15 
RFORE(8)=0.04 
RFORE(6)=0.0 
IF  (GDB-2.06)  22,23,23 

23  CONTINUE 
RBIL=0.0 
GO  TO  24 

22  CONTINUE 

DO  25  J=2,6 

ITEMP  =  J 

IF  (GDB-GKDB(J))  26,26,25 

25  CONTINUE 

26  CONTINUE 
J  =  ITEMP 

RBIL=(RFQRE(J)-RFQRE(J-1))/(GKDB(J)-GKDB(J-1))*(GDB-GKDB(J-1)) 
2  +RF0RE(J-1) 

24  CONTINUE 
FIG10=RBIL 


:(2)=0,6 

U3)=0.34 


RETURN 

END 


C  DECK  FIG 11 

FUNCTION  FIGll  (BDG) 

DIMENSION  BAFT(6) ,CAFT(5) 

generates  function  of  figure  11  of  TANAKA, 

J.  2QSEN  KIOKAI,  V.  109,  U961 

BAFT(l)=1.0 

BAFT{2)=i.25 

BAFT(3)=1.6 

BAFT(4)=2.0 

BAFT(6)=2.25 

CAFT(1)=0.22 

CAFT(2)=0.24 

CAFT(3)=0.3 

CAFTU)=0.6 

CAFT(5)=0.63 

DO  33  J=2,B 

ITEMP  =  J 

IF  (BDG-BAFT(J))  34,34,33 

33  CONTINUE 

34  CONTINUE 
J  s  ITEMP 

FIG11=(CAFT(J)-CAFT(J-1))/(BAFT(J)-BAFT(J-1))* 
+  (BDG-BAFT(J-i))+CAFT(J-l) 


RETURN 

END 


C  DECK  FIG56 

FUNCTION  FIG56  <THM,BDG) 

*  generates  function  of  figures  6  eind  6  of  TANAKA, 

*  5.  ZOSEN  KIOKAI,  VOL.  109,  1961 

DIMENSION  F1(15),BDKG(1B) 

IF  (THM-0.1745)  3,3,4 
3  CONTINUE 
FlCl)=0.45B 
Fl{2)=0.62 
Fl(3)=0.42 
Flf4)=0.3B  ■ 

Fl(6)=0.62 
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GO  TO  E 

4  CONTINUE 

IF  (THM-0.2618)  6,6,7 

6  CONTINUE 

FAC=(THM-0, 1745)/ (0.2618-0. 1745) 

Fl( 1 )=( 0.32-0. 455) ♦FAC+0. 455 
Fl(2)  =  (C.34-0.52)»FAC-t-0.52 
Fl(3)=(0.29-0.42)*FAC+0.42 
Fl(4)-(0.31-0.35)*FAC+0.35 
FI (5)= (0 . 48-0 . 52) ♦FAC+0 . 62 
GO  TO  5 

7  CONTINUE 

IF  (THM-0.3491)  8,9,9 

8  CONTINUE 

FAC=(THH-0. 2618)/ (0.3491-0. 2618) 

FI ( 1 ) =(0 . 25-0 . 32) ♦FAC+0 . 32 
Fl(2)=(0.25-0.34)*FAC+0.34 
FI ( 3) =(0 . 22-0 . 29) ♦FAC+0 . 29 
F1(4)=(0.28-0.31)*FAC+0.31 
Fl(6)=(0.45-0.48)*FAC+0.48 
GO  TO  E 

9  CONTINUE 
Fl(l)=0.25 
F1(2)=0.25 
Fl(3)=0.22 
Fl(4)=0.28 
Fl(6)=0.46 

5  CONTINUE 
Fl(6)=0.63 
Fl(7)=0.63 
Fl(8)=0.59 
F1(9)=0.63 
F1(10)=0.4 
F1(11)=0.36 
FU12)=0.32 
F1(13)=0.3 
DO  I  1=1,5 

BDKG(I)=1./(60.-I*10.) 

1  CONTINUE 
BDKG(6)=1./6. 

DO  2  1=7,13 

BDKG(I)=0.6+0.B*(I-7) 

2  CONTINUE 

DO  27  J=2,13 

ITEMP  =  J 

IF  (BDG-BDKG(J))  28,28,27 

27  CONTINUE 

28  CONTINUE 
j  s  ITEMP 

FONE=(F1(J)-F1(J-1))/(BDKG(J)-BDKG(J-1))+(BDG-BDKGO-1))+F1(J-1) 

FIG66=F0NE 

RETURN 

END 

C  DECK  FIG7 

FUNCTION  FIG7  (THM) 

•  generates  function  of  figure  7  of  TANAKA, 

*  J.  ZOSEK  KIOKAI,  VOL.  109,  1961 

IF  (THM-0.0873)  10,10,11 

10  CONTINUE 
AEX=10,6 
GO  TO  12 

11  CONTINUE 

IF  (THM-0.174B)  13,13,14 

13  CONTINUE 

AEX=(7.66-10.6)/(0. 1745-0. 0873)+(THH-O.OB73)+lO. 6 
ViU  iU  12 

14  CONTINUE 

IF  (THM-0.2618)  16,16,16 
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15  CONTINUE 

AEX=(6.34-7.66)/(0.2618-0. l745)'»(THM-0. 1745)+7.66 
GO  TO  12 

16  CONTINUE 

AEX= (B. 28~6. 34) /(O, 3491-0. 2618)* (THM-0. 2618) +6. 34 
12  CONTINUE 
FIC7=AEX 

RETURN 

END 

C  DECK  FIGS 

FUNCTION  FIG6(RDD,ALF) 

♦  generates  function  of  figure  8  of  tanaOca, 

*  J.  ZOSED  KIQKAI,  V.  109,  1961 

DIMENSION  ALF2(B) ,F2(5) 

ALF2{1)=0.0 

ALF2{2)=0.0873 

ALF2(3)=0.1745 

ALF2(4)=0.3491 

ALF2(5)=0.6236 

F2(l)=l. 

IF  (ROD)  44,44,45 

44  CONTINUE 
F2(2)=0.855 
F2(3)=0.765 
F2(4)=0.682 
F2(5)=0.646 
GO  TO  46 

45  CONTINUE 

IF  (RDD-0.0671)  47,47,48 

47  CONTINUE 

F2(2)=(0.745-0.8BS)/0.0571*RDD+0.855 
F2(3)=(0. 670-0. 765)/0.0S71*RDD+0. 766 
F2(4)=(0.745-0.682)/0.0571*RDD+0.682 
F2(S)=(0.916-0.646)/0.0671*RDD+0.646 
GO  TO  46 

48  CONTINUE 

IF  (RDD-0.1142)  49,49,50 

49  CONTINUE 
F2(2)=0.74 

F2(3)=(0.72-0.670)/(0.1142-0.0571)*(RDD-0.0571)+0.67 
F2(4)=(0. 89-0. 746) /(O, 1142-0. 0571) ♦(RDD-0.0B7l)+0. 745 
F2(B)=(1.34-0.91B)/(0.1142-0.0571)*(RDD-0.06"1)+0.916 
GO  TO  46 

60  CONTINUE 

IF  (RDD-0.1713)  61,61,62 

61  GONTTNIIE 

F2p)=(0.70-0.74)/(0.1713-0.1142)*(RDD-0.1142)+0.74 

F2(3)=0.72 

F2 (4)= (1.20-0. 89)/(0. 1713-0. 1142)* (RDD-0.1l42)+0. 89 
F2(6)=(1.94-1.34)/(0.1713-0.1142)*(RDD-0.1142)+1.34 
GO  TO  46 

62  CONTINUE 
F2(2)=0.7 
F2(3)=0.72 
F2(4)=1.2 
F2(6)=1.94 

46  CONTINUE 
DO  63  J=2,6 
TTEKP  ^  J 

IF  (ALF-ALF2(J))  64.64,53 

63  CONTINUE 

64  CONTINUE 
J  =■  ITEMP 

F2ALF=(F2(J)-F2(J-1))/(ALF2(J)-ALF2(J-1))*(ALF-ALF2(J-1))+F2(J-1) 

r*T  A  T  P 


RETURN 


END 


C  DECK  FINT3P 

SUBROUTINE  FINTSP  (OMEGAE) 

COMMON  /CHSD/  ISIGMA .SIGMIH .SIGMAX .V .SINMU , COSMU, WTSI , 

2  IMMIN, INMAX, IHDEL.LMIN.LMAX 

REAL  SIGMIN, SIGMAX, V, SINMU, COSMU, WTSI (4) 

INTEGER  ISIGMA , IMMIN , IHHAX , IMDEL.LMIN .LMAX 

COMMON  /ENVIOR/  VK ,NVK , MU , NMU , OMEGA , NOMEGA , SIGMA , NSIGMA . SIGWH , 

1  NSIGWH,TMODAL,NTMOD,HRANG,RANG,RLANG,S,NNMU,FRNUM,VFS 
INTEGER  NVK ,NHU , NQMEGA , NSIGMA .NSIGWH , NTMOD , NRANG . NNMU(6) 

REAL  VK(8) ,MU(37,8) ,OHEGA(30) ,SIGMA( 10) ,SIGWH(4) .TMDDAL(8 ) , 

2  RANG(8) ,RLANG(8),S(30,8) ,FRNUM(8) .VFS(8) 

ISIGMA  =  1 
NSIGMX  =  NSIGMA  -  1 
DO  10  IS=1, NSIGMX 

IF  (OMEGAE  .LT.  STGMA(IS))  GO  TO  20 
ISIGMA  =  IS 
10  CONTINUE 
20  CONTINUE 

SIGKIN  =  SIGMA(ISIGMA) 

SIGMAX  =  SIGMA(ISIGMA+1) 

XI  =  OMEGAE  "  SIGMIN 

X2  =  SIGMAX  -  OMEGAE 

XX  =  SIGMAX  -  SIGMIN 

WTSiCl)  =  X2/XX 

WTSI(2)  =  (X2*X2/XX  -  XX)*X2/6.0 
WTSI(3)  =  Xl/XX 

WTSI(4)  =  (X1*X1/XX  -  XX)*Xl/6.0 

RETURN 

END 

C  DECK  FNEDDY 

SUBROUTINE  FNEDDY 

COMMON  /APPEND/  NBKSET,NBKSTN(2) ,BKIMAG(2) .BKFS(2) ,BKAS(2) , 

2  BKWD ( 2 ) , BKSTN ( 10 , 2 ) , BKHB (10,2), BKLNTH , BKWDTH , 

2  BKWLa0,2) ,BKAN(10,2),NSKSET,SKIMAG(2),SKFLS(2),SKALS(2) , 

2  SKAUS(2).SKHB(2),SKFLWL(2) ,SKALUL(2) ,SKAUWL(2) ,NRDSET,RDIMAG(2), 

2  RDRFS(2),RDRAS(2),RDRHB(2) ,RDRFWL(2) ,RDRAWL(2) .RDTFS(2) ,RDTAS(2), 
2  RDTHB(2) ,RDTFWL(2) ,RDTAWL(2) ,NSBSET,SBIMAG(2) .S0BRFS(2) ,S0BRAS(2) 
2,S0BRHB(2) ,S0BRFWC2) ,S0BRAW(2) ,SIBRFS(2) ,SIBRAS(2) ,SIBRHB(2) , 

2  SIBRFW(2) ,SIBRAW(2) ,SBTFS(2) ,SBTAS(2) .SBTHB(2) ,SBTFWL(2) , 

2  SBTAWL(2) ,NFNSET.FNIMAG(2) ,FHRFS(2) ,FNRAS(2) , 

2  FNRHBC2) ,FNRFWL(2) ,FNRAWL(2) ,FNTFS(2) ,FNTAS(2) ,FNTHB(2) , 

2  FKTFWL(2) ,FNTAWL(2) ,NEXPRD .ENRD0(8) ,ENRDS(8) 

COMMON  /CH3D/  ISIGMA , SIGMIN , SIGMAX, V ,SINK’J,COSKU , WTSI , 

2  IMMIN, 1MHAX,IMDEL,LM1N, LMAX 

REAL  SIGMIN, SIGMAX, V, SINMU, COSMU, WTSI(4) 

INTEGER  ISIGMA, IMMIN, IHMAX, IMDEL.LMIN, LMAX 

COMMON  /ENVIOR/  VK, NVK, MU, NMU, OMEGA, NOMEGA, SIGMA, NSIGMA, SIGWH, 

1  NSIGWH .TMODAL , NTMOD , NRANG , RANG ,RLANG ,S ,NNMU ,FRNUM ,VFS 
INTEGER  NVK . NMU , NOMEGA , NSIGMA , NSIGWH , NTMOD , NRANG , KNMU(8 ) 

REAL  VK(8) ,MU(37,8) ,0MEGA(30) ,SIGMA( 10) ,SIGWH(4) ,TM0DAL(8) , 

2  RANG(8) ,RLAHG(8) ,S(30,8) ,FRNUM(8) ,VFS(8) 

COMMON  /PHYSCO/  II, TPI, PI, PIOT, DEGRAD, RAnDEG,VKMETR,KETRVK,GRAV, 
2  RHO , GNU , RH03 , RHOF , GNUS , GNUF , FTMETR , PUNITS , REYSCL 
COMPLEX  II 

CHARACTER*4  PUNITS(2) 

REAL  TPI , PI , PIOT , DEGRAD , RADDEG , VKKETR ,MErrRVK , GRAV , RHO , GNU , RHOS , 

1  RHOF. GNUS, GNUF,  FTMETR 

COMMON  /RLDBK/  PSUR(25) .BMK (25) .DK(26) ,CAK(25) , HQ ,HSPAN , HMNCHD , 

2  HAREA,HXCP,HYCP,HZCP,HGAMMA,KYHAT,HEAR,HLCS.RQ(2) ,KSPAH(2) , 

2  RMNCHD(2) ,RAREA(2) ,RXCP(2) ,RYCP(2) ,RZCP(2) ,RGAHMA(2) .RYHAT(2) , 
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2  REAR(2) .RLCS(2) ,SQ(2) ,SSPAN(2) .SMNCHD(2) ,SAREA(2)  SXCP(2) . 

2  SYCP(2)  ,SZCP(2)  ,SGAMHA(2)  ,SYHAT(2)  .SEAR(2)  .SLCS(.2)  , 

2  BSPAN(25 ,BMNCHD(2) ,BAREA(2) , CXCP(25 , BYCP(2) ,BZCP(2) ,BGAMMA(2) , 

2  BYHAT(2) ,BEAR(2 ) , BLCSv2 ) ,FQ (2) .FSPAN (2) ,FMNCHD( 2) .FAREA ^ ^ ) , 

2  FXCP(2)  FYCP(2),FZCP(2) .FGAMMA(2) ,FYHAT(2) ,FEAR(2KfLCSC2) . 

2  PQ(2,2) ,PSPAN(2,2) ,PHNCHn(2.2),PAREA(2,2)  PXCP(2.2)  PYCP(2.2) , 
PZCP(2  2^  PGAMHA(2 , 2) ,PYHAT(2 ,2) , PEAR(2 ,2 ; , PLCS (2 . 2; . 

2  STADHP(i65 ,SHPDMP(10.8) .EMCON.WPHI ,TPHI.yMELM(4 , 9 SPELM (4 , 9 , 8 ) 

2  REELH(4,9,8) , PEELM (4 , 9 , 8 \FEELH(4 , 9 , 8) , HEELH (4 , 9 . 8 )  BEELMC4 , 9 , 8 ) . 
2  ENUM,ENSF(8,e) ,ENRE(8) ,ENPE(8) ,ENFE(e) .ENHE(8) ,ENBE(8) . 

2  ENEMV(8,8) ,ENRL(8) .ENPL(8) ,ENFL(8) ,EKHL(8 ) . ENSL(8 , ,ENBL(8 ) , 

2  ENSHP(8,8)  ,RELH(4.9)  ,ITS(25)  ,RDt25)  ,EDDY(8,25)  ,RGB(,25) 

REAL  RDBLK(2692)  . 

EQUIVALENCE  (PSUR(l)  .RDBLKU)) 

DO  20  IA=1,NRANG 
ENFE(IA)  =  0 
DO  10  IS=1.HS1GMA 
SHPDMPdS.IA)  =  0 
10  CONTINUE 
20  CONTINUE 

IF  (NFNSET  .EQ.  0)  GO  TO  100 

YHAT°^*^SQRT(FYCP(K)*FYCP(K)  +  FZCP (K) *F2CP(K) ) 

ALF*^=\tAN(^ABs!‘^((FYCP(K)/FZCP(K))  +  TAN(GAMMAE*DEGRAD))/(1.  - 
2  (FYCP(K)/FZCP(K))*TAN(GAMHAE*DEGRAD))  )  ) 

C  =  0.0065  +  (FLCS(K)*FLCS(K))/(0.9*PI*FEAR(K)) 

CON  =  FQ(K)*4./(3.'*PI)*RHQ»YHAT**3*FAREA(K)*C+SIN(ALF) 

DO  40  IA=1,NRANG 

SHPDMP(Is!iA!^  =  ”sHPDMP(IS.lA)  +  (CON*SIGMA(IS)'<‘RANG(IA) )  * 

2  SIGMA(IS) 

CONTINUE 
CONTINUE 
CONTINUE 

CALL°SPFIt’ (SIGMA, SHPDMPd ,IA) .FEELH( 1 , 1 . lA) .NSIGMA) 

ENFECIA)  “  ENC0N*REVAL(FEELM(1,IS1GMA,IA),WTSI) 

60  CONTINUE 
100  CONTINUE 


30 

40 

60 


RETURN 

END 


C  DECK  FNLIFT 

SUBROUTINE  FNLIFT 

COMMON  /APPEND/  NBKSET,NBKSTN(2) ,BKIMAG(2) .BKFS(2) .BKAS(2) . 

2  BKWD(2),BKSTN(10.2).BKHB(10.2),BKLNTH.BKWpTH.  ,  . 

2  BKWLUO  2) .BKAH(10,2),NSKSET.SKIMAG(2),SKFLS(2) ,SKALS(2)^ 

«  cv'pTUT('^’'  *^KALWL('^''  1  NRDSET .RDIMAG (2 )  . 

2  RDR?I  2  :MRAS(25:MRHBhKRD^wU2KRbMWL(2^:RDTFS(2K 

2  RDTHBd)  ,RDTFWL(25  ,RDTAWL(2)  .NSBSET.SEIMAGd)  ,SDBRFS(2)  ,SpBRAS(2) 

2,S0BRHB(2) .S0BRFW(25 ,S0BRAW(25 .SIBRFSd) ,SIBRAS(2) ,SIBRHB(2) , 

2  SIBRFW(2) ,SIBRAW(2) ,SBTFS(2) ,SBTAS(2) .SBTKB(2) ,SBTFWL(2) , 

2  SBTAWLd), NFNSET, FNIMAG(2),FNRFS(2).FNRAS(2;, 

2  FNRHB(2) ,FNRFWL(2) .FNRAWL(2) ,FNTFS(2) ,FNTAS(2) ,FNTHB(2) , 

2  FNTFWL( 2 5 , FNTAWL( 2 ) , NEXPRD , ENRDO ( 8 ) , ENRDS (8 ) 

COMMON  /ENVIOR/  VK ,HVK , MU, NMU, OMEGA .NOMEGA, SIGMA .NSICHA.SIGWH , 

1  NSIGWH  , TMODAL ,  NTMOD  .  NRANG  ’, R ANG ,  BLANG ,  S  . •  fR^UM  VFS 

INTEGER  NVK, NMU, NOMEGA, NSIGMA, NSIGWH, NTMOD, NRANG, NNMU(8) 

REAL  VK(8),MUd7,0) ,0HEGA(30),SIGMA(ip)  SIGWH(4) ,TM0DAL(8), 

2  RANG(8),RLANgU),S(30,8)  ,FRNUM(8)  ,VFS(8) 

rnMMnii  /GEOH/  X  NSTATH .Y .Z .NOFSET.LPP .BEAM .DRAFT ,LCF, 

1  VCG , GM ,DELGM ,NEBLA .KPITCH ,KROLL ,KYAW ,KYAWRL , AWP , VCB ,FBDX jFBDY , 

9  FBDZ  NFREBD  XPT  YPT  ZPT ,KPTS ,LCB ,GML, ASTAT, BSTAT , TITLE , MASS, 

2  D!skS!lPITCH  dR6Li :  iVaW  ,  lYAWRL . CHEAVE.CPITCH ,  CHEAPI ,  CROLL , 

2  ARbAMX  ,WiUW  , Minin, rouiv 

INTEGER  NSTATN , N0FSET(25 ) , NFREBD , NPTS 
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K3  lO  lO  W  W  10  W  •■J  VJ  to  M  S3  M  >-»  tO  <n  tO  tJ 


CHARACTF.R*4  T1TLE(20) 

REAL  X(26) .Y(10,25) ,Z(10,2&) ,FBDZV(8. 10) .LPP .BEAM .DDLWL.TLCB . 
DRAFT, LCF.VCG, CM, DELGM.KEBLA.KPITCH.KROLL.KYAW.KYAWRL.AWP, VCD. 
FBDX(10),FBDY(10) .FBDZ(IO) ,XPT(10) .YPT(IO) ,ZFT(10) .LCB.GML, 
ASTAT(25) ,BSTAT(25) .MASS .DISPLM . IPITCH . IROLL ,I YAW , 

I YAWRL , CHEAVE , CPITCH . CHEAPI , CROLL , AREAKX , WSURF , GIRTH ( 26 ) 

COMMON  /PHYSCO/  II .TPI.Pl ,P10T .DEGRAD , RADDEG .VKMETR , METRVK , GRAY , 
RHO . GNU . RHOS , RHQF . GNUS , GNUF . FTMETR .PUNITS , REYSCL 
COMPLEX  II 

CHARACTER*4  PUH1TS(2) 

REAL  TPI . P I . P lOT , DEGRAD , RADDEG , VKHETR , HETRVK , GRAY , RHO , GNU , RHOS , 
RHOF , GNUS , GNUF , FTMETR 

COMMON  /RLDBK/  PSUR(26) .BMK(25) ,DK(25) ,CAK(25) ,HQ .HSPAN .HHNCKD , 
HAREA ,HXCP ,HYCP ,HZCP .HGAMMA .HYH AT.HEAR , HLCS . RQ(2) .RSPAN  C2) , 
RMHCHD(2) .RAREA(2) ,RXCP(2) .RYCP(2) .RZCP{2) . RGAMMA (2) , RYHAT(2 ) , 
REARfZ) ,RLCS<2) ,SQ(2) ,SSPAN(2) .SMNCHD(2) .SAREA(2 ) ,SXCP( 2) , 

SYCP(2) ,SZCP(2) .SGAMMA(2) .SYHAT(2) ,SEAR(2) ,SLCS(2) ,BQC2) , 

BSPAN(2) .BMNCHD(2) ,BAREA(2) ,BXCP(2) .BYCP(2) . BZCP ( 2) , BGAMM A (2 ) , 
BYHAT(2)  .BEAR(2)  .BLCS(2)  .FC|(,2)  .FSPAN(2)  .FMNCHD(2 )  .FAREA (2 )  , 
FXCP(2) .FYCP(2) ,FZCP(2) .FGAMMA(2) .FYHAT(2) .FEAR(2) .FLCS(2) , 
PQ(2,2) ,PSPAN(2.2) ,PMNCHD(2,2) .PAREA(2 .2) ,PXCP(2 . 2) , PYCP(2 , 2) , 
PZCP(2,2) ,PGAMMA(2.2) .PYHAT(2.2) .PEAR(2 ,2 ) , PLCS( 2 , 2 ) . 

STADHP(IO) ,SHPDMP(10.8) .ENCON.WPHI.TPHI ,WHELM(4 . 9 ) ,SFELM(4 , 9 . 8) , 
REELM(4.9,8) .PEELM(4 ,9 .8) . FEELM(4 . 9 .8) .HEELH(4 ,9 , 8) , BEELM(4 , 9 , 8) , 
ENWM.EHSF(8,8) ,ENRE(8) .ENPE(e) ,ENFE(8) .ENHEsS) , ENBECS ) , 

ENEMV<;8,8)  ,ENRL(;8)  ,ENPL(8)  .ENFL(;8)  ,ENHL(8)  .ENSL(8)  ,ENBL(8)  , 
ENSHPCe .8) ,RELM(4.9) .ITS(25) .RD(25) ,EDDY(8,26) ,RGB(26) 

REAL  RDBLK(2692) 

EQUIVALENCE  (PSUR( 1) . RDBLK( 1 ) ) 

REAL  LCS.MCHORD 

IF  (KFNSET  .EQ.  0)  GO  TO  20 
EN  =  0 

STASPC  =  LPP/20 
DO  10  Ksl.NFNSET 
XRTF  =  LCB  -  FNRFS(K) ‘STASPC 
XRTA  =  LCB  -  FNRAS(K) ‘STASPC 
XVPF  =  LCB  -  FSTFS(K)‘ STASPC 
XTPA  =  LCB  -  FKTAS(K) ‘STASPC 
YRT  =  FNRKBfK) 

YTP  =  FKTBB(K) 

ZRT  =  (FNRFWLsK)  +  FKRAWL(K))/2  -  pBLWL+VCG) 

ZTP  =  (FNTFWL(K)  +  FNTAWL(K))/2  -  (DBLWL+VCG) 

SPAN  =  SQRT((ZRT-ZTP)“2  +  0’TP-YRT)“2) 
q  =  FHIMAG(K) 

MCBORD  ‘  0.6‘((XRTF-XRTA)  +  (XTPF-XTPA)) 

CR  =  XRTF  -  XRTA 
CT  =  XTPF  -  XTPA 
XRQC  =  XRTF  -  0.26‘CR 
XTQC  =  XTPF  -  0.26‘CT 
DX  =  XRQC  -  XTQC 
H  =  SQRT(DX‘DX  +  SPAN*SPAN) 

COSLAM  =  SPAN/H 
SECLAK2  =  l./(COSLAM*COSLAM) 

*  LAM  =  ACOS(SPAN/B) 

♦  =  quarter  chord  sveep  angle  in  radians 


•  area 

AREA  SPAN«MCHORD 

‘  center  ojC  pressure 

ZP  =  O.B*(ZRT  +  ZTP) 

YP  =  0.6* (YRT  +  YTP) 

XO  =  O.E‘(XRTF  +  XTPF) 
XCF  =  XC  -  C.25^KCaQPd) 
YCP  =  YP 


G3 


ZCP  =  ZP 


*  moment  ana 

ARG  =  (ZRT-2TP)  /  SPAN 
GAMMA  =  -  90 

IF  (ARG  .LT.  1)  GAMMA  =  -  ASIN ( ARG)*RADDEG 

GAM  =  GAHMA+DEGRAD 

YHAT  ==  YCP»COS(GAH)  +  ZCPfSIN(GAM) 

*  effective  aspect  ratio 

EAR  =  2+SPAN/MCHORD 

*  lift  curve  slope 

LCS  =  1.8+PI*EAR/(C0SLAM+SQRT((EAR*SECLAH2)t‘*2  +  4)  +  1.8) 

FQ(K)  -  Q 
FSPAN(K)  =  SPAN 
FMHCHD(K)  =  MCHORD 
FAREA(K)  =  AREA 
FXCP(K)  =  XCP 
FYCP(K)  =  YCP 
FZCP(K)  =  ZCP 
FGAHMA(K)  =  GAMMA 
FYHAT(K)  =  YHAT 
FEAR(K)  =  EAR 
FLCS(K)  *  LCS 

EN  ='eN  +  Q*(RHQ/2)+AREA*LCS*YHAT*YHAT*WPHI*ENC0N 
10  CONTINUE 
20  CONTINUE 

DO  30  IV=1,NVK 
ENFL(IV)  =  0 

IF  (NFNSET  .GT.  0)  ENFL(IV)  =  EN*VFS(IV) 

30  CONTINUE 

RETURN 

END 

C  DECK  FNRAO 

SUBROUTINE  FNRAO  (IV , NE , NU , MOTL, RAO , PHS ,NMOT , HOHEGA , OMEGAE , IPHS ) 

COMMON  /FINCOH/  IACTFN,IFCLCS,FGAIN(8) ,FK(3) ,FA(3) ,FB(3) , 

2  FCLCS(8.2) 

COMMON  /PHYSCO/  II.TFI.PI,PIOT,DEGRAD,RADDEG,VKHETR.METRVK,GRAV, 
2  RHO , GNU , RHOS , RHOF , GNUS , CNUF , FTMETR , PUNITS , REYSCL 
COMP1.EX  II 

CHARACTER*4  PUNITS (2) 

REAL  TPI, PI, PIOT, DEGRAD, RADDEG,VKMCTR,METRVK,GRAV, RHO, GNU, RHOS, 

1  RHOF, GNUS, GNUF, FTMETR 

COMPLEX  FGC, MOTL (NMOT, NOMEG A), BETA, ROLL 
DIMENSION  OMEGAE (NOMEG A) ,RAO(NOHEGA) ,PHS(NOMEaA) 

DO  10  I=NL,NU 

ROLL  =  M0TL(2,I)*RADDEG 

OMGE  =  OMEGAE(I) 

0MGE2  =  OMGE*OMGE 

FGC  =  ((FK(1)-OMGE2»FK(3))+II*OMGE*FK(2))/(((FA(1)-ONGE2*FA(3))+ 

2  II*OMGE*FA(2))e((FB(l)-OMGE2<*‘FB(3))+II*OMGE*FB(2))) 

BETA  =  FGAIN(IV)*FGC*ROLL 

CALL  RAOPHA  (BETA, RAO(I) ,PHS(I) .RADDEG, IPHS) 

10  CONTINUE 

RETURN 

END 

C  DECK  FTHO 

FUNCTION  FTWO  (K,TLOCAL,RD) 

COMMON  /GEOM/  X,HSTATN,Y,Z,HOFSET,LPP, BEAM, DRAFT, LCF, 
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«  * 


1  VCG , GM , DELGM , NEBLA , KPITCH , KRQLL , KYAW ,KY AWRL , AWP , VCB , FPOX , FBDY , 

2  FBDZ , NFREBD , XPT , YPT , ZPT , NPTS , LCB . GML , ASTAT , BSTAT , TITLE , M ASS , 

2  DISPLM , IPITCH , TROLL , lYAW , lYAWRL , CHEAVE , CPITCH , CHEAPI , CROLL , 

2  AREAMX , WSURF .GIRTH , FBDZV .DBLWL ,TLCB 

INTEGER  NSTATN.N0FSET(25) , NFREBD, NPTS 
CHARACTER*4  TITLE(20) 

REAL  X(2B) .Y( 10,25) ,Z( 10 .25) .FBD2V(8 , 10) .LPP .BEAM .DBLWL ,TLCB , 

2  DRAFT , LCF , VCG , GM , DELGM .NEBLA , KPITCH . KRQLL, KYAW . KY AWRL  ,  AWP  .  VCB , 
2  FBDX(10),FBDY(10) ,FBDZ(10) .XPI'CIO) ,YPT(10) .ZPT(IO) .LCB, GML, 

4  ASTAT(25).BSTAT(25) .MASS .DISPLM , IPITCH . IROLL , lYAW . 

6  lYAWRL . CHEAVE . CPITCH , CHEAPI .CROLL , AREAMX , WSURF , GIRTH (25 ) 

NNODES=NOFSET(K) 

FTW0=1.0 

IF  ((Y(NNDDES-1.K)-Y(NNODES,K)).GE.O.)  RETURN 
BR=(Y(NNODES.K)-Y(NNQDES-l,K))/(-Z(NNODES-l,K)) 

ALF=ATAN(BR) 

RDD  =  RD/ABS(TLOCAL) 

FTW0=FIG8(RDD,ALF) 

RETURN 

END 


C  DECK  SENOFS 

SUBROUTINE  GENOFS  (BEAM.DRAFT.SECARE.NOFSET.HLFBTH.WTRLNE. 

2  PI, DBLWL) 

this  routine  generates  a  set  of  offsets  for  evenly  spaced  angles 
from  the  beam,  draft  and  sectional  area  coefficients  of  a  station 

*  using  the  LEWIS  form  mapping. 

*  W.G. MEYERS,  DTSNRDC,  080977 

LEWIS  FORM  representation- 

*  Z  =  A1  •  ZETA  +  A2  *  2ETA**-1  +  A3  *  ZETA**-3 

*  where  ZETA  is  a  complex  mapping  variable  aiid  Al,  A2  and  A3 
are  coefficients. 

*  phi  is  an  angle  measured  from  the  waterline  down  and  is  negative. 

DIMENSION  HLFBTB(NOFSET) ,WTRLNE(NOFSET) 

HBEAM  =  BEAM/2 

AREA  =  SECARE*BEAM*DRAIT 

A3  =  -.25*(HBEAM+DRAFT)  +  .25*SQRT((HBEAM+DRAFT)**2  + 

2  8e(HBEAM*DRAFT-2‘*AREA/PI)) 

A2  =  .60*(HBEAM-DRAFT) 

Al  =  .60e(HBEAM+URAFT)  -  A3 
DELPHI  =  (PI/2)/(HQFSET-l) 

KOF5ET  =  NQFSET  +  1 
DO  10  I0FSET=1,N0FSET 
PHI  =  -(lOKSET-1) •DELPHI 
KOFSET  =  KOFSET  -  1 

HLFBTH(KOFSET)  =  (A1+A2)*C0S(PHI)  +  A3*COS(3*PHI) 

WTRLNE (KOFSET)  =  (A1-A2)*SIN(PRI)  -  A3*SIH(3*PHI) 

WTRLNE( KOFSET)  =  WTRLNE (KOFSET)  +  DBLWL 
10  CONTINUE 

RETURN 

END 

C  DECK  GRNFRQ 

SUBROUTINE  GRNFRQ  (YS,  ZS,  NPT,  SIGMA2,  POTLOG,  PTNLOG,  CN.  SN , 
2  CTV,  CTL,  GREENV,  GREENL) 


*  this  subroutine  provides  the  necessary  input  for  the  subroutine 

*  EXPIHT,  and  provides  the  entire  expression  of  the  pulsating  source 

•  which  are  stored  in  GREENV(I,J)  for  the  symmetric  flow(Burge  and 

♦  heave)  and  in  GREENL(I,J)  for  the  anti-symmetric  flow(sway  and 

*  roll)  where 

♦  I  =  location  of  source 


*  J  =  location  of  the  field  point  on  the  cross  section 

*  boundary 

*  the  normal  derivatives  of  the  foregoing  green  functions  are  stored 

*  in  CTVCI.J)  and  CTL(I,J)  respectively. 

COMMON  /PHYSCO/  II , TPI . PI , PIOT .DEGRAD , R ADDEG , VKMETR , METRVK , GRAV , 

2  RHO , GNU ,RH0S , RHQF , GNUS , GNUF , FTMETR.PUNITS , REYSCL 
COMPLEX  II 

CHARACTER*4  PUN1TS(2) 

REAL  TP I . P I , P 1 OT . DEGRAD , RADDEG , VKMETR . METRVK , GRAV , RHO , GNU , RHOS . 

1  RHOF, GNUS, GNUF. FTMETR 

COMMON  /TWOD/  YY.  ZZ,  ENN,  ISTA 
INTEGER  ISTA 

REAL  YY(10.2B).ZZ(10.25) .ENN(4. 10 .25) 

COMPLEX  CTV(IO.IO).  CTL(l0,10).  GREENVdO. 10) .  GREENL(10 , 10) 
DIMENSION  YS(ll).  ZS(ll) 

DIMENSION  PQTL0G(2.10.10K  PTHLQG(2. 10. 10) .  CN(IO).  SN(IO) 

DO  1  1=1. NPT 

YRl  =  SIGMA2-»(YY(I,ISTA)-YS(1)) 

ZRl  =  -SIGHA2*(Z2(I,1STA)+2S(1)) 

YLl  =  SIGMA2t‘(YY(I.ISTA)+YS(l)) 

ZLl  =  ZRl 

CALL  EXPINTCYRI .ZRl ,EJ1 .CXRl .SXRl .RARl .RBRl .CRl .SRI) 

CALL  EXPINT(YL1.2L1.EJ1,CXL1.SXL1.RAL1.RBL1,CL1.SL1) 

DO  1  J=1,NPT 

YR2  =  SIGMA2*(YY(I.1STA)-YS(J+1)) 

ZR2  =  •-SIGMA2*(Z2(I.ISTA)+ZS(J+1)) 

YL2  =  SIGMA2*(YY(I.ISTA)+YS(J+1)) 

2L2  =  2R2 

CALL  EXPINT( YR2 .2R2 . E J2 , CXR2 .SXR2 .RAP2 . RBR2 , CR2 .SR2 ) 

CALL  EXP I NT ( YL2 ,2L2 . E J2 , CXL2 . SXL2 , RAL2 , RBL2 , CL2 . SL2 ) 

SIPJ  =  SNfI)*CH(J)+SN(J)fCN(I) 

CIPJ  =  cn(iWcn(j)-sn(i)*sn(j) 

SIHJ  =  SHCI)*CNU)-SNd)*CNd) 

CIMJ  =  CH(I)*CH(JWsN(I)*SN(J) 

DPR  =  2.*(SIPJ*(CR1-CR2)  -CIPJ*(SR1-SR2)) 

DPL  =  2.*(CIMJt(SLl-SL2)-SIMJ*(CLl-CL2)) 

PPR  =  2./SIGMA2*(SN(J)*(RARl-RAR2)+CN(J)*(RBRl-RBR2)) 

PPL  =  2./SIGMA2*(SN(J)*(RALl-RAL2)+CN(J)‘f(RBL2-RBLl)) 

DWR  =  TPI*(EJ2*(SXR2*CIP,l-CXR2*SIPJj-EJl*(SXRl*CIPJ-CXRl*SIPJ)) 
DWL  =  TPI*CEJ1*(SXL1*CIMJ-CXL1*SIMJ)-EJ2*(SXL2*CIMJ-CXL2^SIMJ)) 
PWR  =  TPI/SIGMA2*(EJ1»(SXR1*CN(J)-CXR1*SN(J))-EJ2*(SXR2*CN(J)- 

2  CXR2*SN(J))) 

PWL  =  TPI/SIGMA2*(EJ2*(SXL2*CN(J)+CXL2*SN(J))- 
2  EJ1*(SXL1*CN(J)+CXL1*SN(J))) 

CTVa.J)  =  PTNL0G(1.I,J)+DPR+DPL-II*(DWR+DWL) 

CTL(I.J)  =  PTNL0G(2,I.J)+DPR-DPL-II*(DWR-DWL) 

GREENV(I.J)  =  POTLOG(l.I.J)+PPR+PPL-IIe(PWR+PWL) 

GREENL(I.J)  =  POTLOG(2,I.J)+PPR-PPL-II*(PWR-PWL) 

IF  (J-KPT)  2.1,1 
2  YRl  =  YR2 
ZRl  =  ZR2 
CXRl  =  CXR2 
SXRl  =  SXR2 
RARl  =  RAR2 
RBRl  =  RBR2 
CRl  =  CR2 
SRI  =  SR2 
YLl  =  YL2 
ZLl  =  ZL2 
EJl  =  EJ2 
CXLl  =  CXL2 
SXLl  =  SXL2 
RALl  =  RAL2 
RELl  =  RBL2 
CLl  =  CL2 
SLl  =  SL2 
1  rnwriNiiF, 
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RETURN 

END 


C  DECK  GRNLOG 

SUBROUTINE  GRNLOG  (YS,  ZS.  HPT,  PQTLOG,  PTNLOG.  CN ,  SN) 

*  this  subroutine  computes  the  logztrithm  part  of  the  pulsating 

+  source  and  its  normal  derivative,  and  are  stored  in, respectively , 

*  in  P0TL0G(M,I. J)  and  P0TNL0G(M,1, J)  where 

*  m=i  symmetric  How  about  the  z^axis (surge  and  heave) 

*  2  anti-symmetric  ilou(sway  and  roll) 

*  i=location  of  source 

*  j=f ield-point  location  on  cross-section  boundary 

COMMON  /PHYSCO/  II ,TPI , PI ,PIOT, DEGRAD .RADDEG , VKMETR ,METRVK ,GRAV , 

2  RHO . GNU , RHOS . RHOF , GNUS , GNUF , FTMETR , PUNITS , REYSCL 
COMPLEX  II 

CHARACTER‘*4  PUNITS(2) 

REAL  TPI , PI , PIOT , DEGRAD , RADDEG , VKMETR , METRVK ,GRAV , RHO , GNU , RHDS , 

1  RHOF, GNUS, GNUF, FTMETR 

COMMON  /TWOD/  YY,  22,  ENN,  ISTA 
INTEGER  ISTA 

REAL  YY(10,2B)  ,ZZ(10,25) ,ENN(4,10,25) 

DIMENSION  YS(ll)  ,  ZS(ll) 

DIMENSION  P0TL0G(2,10,10),  PTNL0G(2. 10 , 10) .  CN(IO),  SN(lO) 

DO  15  1=1, HPT 
SN(I)=  -ENN(2,I,ISTA) 

16  CN(I)=  ENH(3,I,ISTA) 

DO  10  1=1, NPT 

YMl  =  YY(1,ISTA)  -  YS(1) 

ZMl  =  ZZ(I,ISTA)  -  2S(1) 

YPl  =  YY(I,ISTA)  +  YSCl) 

ZPl  =  ZZa.ISTA)  +  2S(1) 

FPRl  =  0.6*AL,AG(YM1**2+ZM1**2) 

FPLl  =  0.B*ALAG(YP1**2+2M1**2) 

FCRl  =  0.6*ALAG(YMl*t‘2+ZPl*'*2) 

FCLl  =  0.6«ALAa(YPl**2+ZPlf*2) 

APRl  =  ATAH3(2M1,YM1) 

APLl  =  ATAN3(2M1,YP1) 

ACRl  =  ATAN3(ZP1,YM1) 

ACLl  =  ATAH3(ZP1,YP1) 

DO  10  J=1,NPT 

YM2  =  YY(I,ISTA)  -  YS(J+1) 

ZM2  =  22(1, ISTA)  -  ZS(J+1) 

YP2  =  YY(I,ISTA)  +  YSU+l) 

ZP2  =  ZZ(I,ISTA)  +  ZS(J+1) 

APR2  =  ATAH3(ZM2,YM2) 

FPR2  =  0.8*ALAG(YM2**2+ZH2**2) 

FCR2  =  0.6*ALAG(YM2»*2+ZP2**2) 

FPL2  =  0.6*ALAG(YP2**2+ZM2**2) 

FCL2  =  0.6*ALAG(YP2**2+ZP2**2) 

J1  =  J  +  1 

IF  (YK2  .GE.  0.)  GO  TO  4 
IF  (J1  .GT.  I)  GO  TO  6 

below  takes  care  of  a  concave  top  or  a  flat  top 

IF  (2M2  .LT.  0.)  APR2  =  APR2+TPI 
GO  TO  6 

*  below  takes  care  of  a  convex  bottom  or  a  flat  bottom 

6  IF  (2M2  .GE.  0.)  APR2  =  APR2-TPI 
B  IF  (2P2  .LT.  0.)  GO  TO  4 
ACR2  =  -  0.6*TPI 
GO  TO  3 

4  ACR2  =  ATAN3(ZP2,YM2) 

3  irr.o  =  AT*N3(ZP2.YP2) 

'aPL2  =  ATAN3(ZM2,YP2) 
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SIMJ  =  SN(I)*CHp)-SN(.7)*CN(I) 

CIMJ  =  CN(l)*CN( J)+SN(I)*SN( J) 

SIPJ  =  SN(I)*CN(J)+SN(J)*CN(I) 

CIPJ  =  CN(I)*CN(J)-SN(I)*SN(J) 

DPHR  =  S1MJ*(FPR1-FPP,2)+CIMJ*(APR1-APR2) 

UPNL  =  SIPJ*(FPL2-FPLl)+CIPJ*(APL2-APLl) 

DCNR  =  SIPJ*(FCR1-FCR2)+CIPJ*(ACR1-ACR2) 

DCNL  =  SIMJ*(FCL2-FCL1)+CIMJ*(ACL2-ACL1) 

PTNLOa(l,I,J)  =  DPNR+DPNL-DCNR-DCNL 
PTNLDG(2,I,J;  =  DPNR-DPNL-DCNR+DCNL 

PPR  =  CN(J)»(YH1*FPR1-ZM1*APR1-YM1-YM2*FPR2+ZM2*APR2+YM2)  + 

2  SN(J)*(ZMlfFPRl+YMl*APRl-ZMl-ZM2+FPR2-YM2^APR2+ZM2) 

PPL  =  CN(J)*(YP2*FPL2-ZM2*APL2-YP2-YP1+FPL1+ZH1»APL1+YP1)  + 

2  SN ( J ) ♦ (ZM1*FPL1+YP1*APL1+ZM2-ZM2»FPL2-YP2* AP1.2-ZM1 ) 

PCR  =  CN(J)*(YM1*FCR1-ZP1*ACR1~YM1-YM2*FCR2+ZP2*ACR2+YM2)  + 

2  SN(J)*(ZP2*FCR2+YM2»ACR2+ZP1-ZP1*FCR1-YM1*ACR1-ZP2) 

PCL  =  CN(J)*(YP2*FCL2-ZP2*ACL2-YP2-YP1*FCL1+2P1*ACL1+YP1)  + 

2  SN(J)*(ZP2'»FCL2+YP2+ACL2-ZP2-ZPl*FCLl-YPlfACLl+ZPl) 
P0TL0G(1,I,J)  =  PPR+PPL-PCR-PCL 
PC}TL0G(2,I,J)  =  PPR-PPL-PCR+PCL 
IF  (J-HPT)  475,10,10 
475  YHl  =  YM2 
ZMl  =  ZM2 
YPl  =  YP2 
ZPl  =  ZP2 
FPRl  =  FPR2 
FPLl  =  FPL2 
FCRl  =  FCR2 
FCLl  =  FCL2 
APRl  =  APR2 
APLl  =  APL2 
ACRl  =  ACR2 
ACLl  =  ACL2 
10  CONTINUE 

RETURN 

END 

C  DECK  HLEDDY 

SUBROUTINE  HLEDDY 

CALL  SECTl 
CALL  TANAKA 
CALL  Vise 

RETURN 

END 

C  DECK  HLLIFT 

SUBROUTINE  HLLIFT 

COMMON  /DATINP/  OPTH,MOTN,BSCFIL,VLACPR,RAOPR,RLDMPR,DISPLMT, 

2  LRAOPR,ADRPR,ORGOPTN,GMNOM,KG,STATK(26),NSOFST(25) , 

2  NLEWF ( 25 ) , HLFBTH (10,26),tfTRLHE(10,2B),BLEWF(25), TLEWF ( 25 ) , 

2  AREALF(26) ,NPTL0C,PTNUMB(10) ,PTNAME,KPTL0C(10) ,YPTL0C(10) , 

2  ZPTLOCCIO) ,NBB,FBNUMB(10) .FBNAME,XPTFBD(10) ,YPTFBD(10) , 

2  ZPTFBD (10 ) , FBCODEC 10) , FBTYPE , RDOT( 10) , VKDES . FNDES , 

2  STATNM,STATIS 

CHARACTER*4  PTNAME(8,10) ,FBNAME(8,10) ,STATNM(6) ,FBTYPE(3,10) 
INTEGER  OPTN , MOTN , BSCFIL , VLACPR , RAOPR, ADRPR , RLDMPR , FBCODE , 

2  FBHUMB,PTNUMB,ORGOPTN 
REAL  KG 

COMMON  /ENVIOR/  VK.NVK, MU, NMU, OMEGA, HOMEGA, SIGMA, NSIGMA,SIGWH, 

1  NSIGWH ,TMODAL , NTMOD , NRANG , RANG , RLASG , S , NNMU , FRNUM , VFS 
INTEGER  NVK , NMU , NOMEG A ,NSIGMA ,NSIGWE , NTMOD , NRANG , NNMU (8 ) 

REAL  VK(8) ,MU(37,8) ,0MEGA(30) ,SIGHA(10),SIGWH(4) ,TM0DAL(8) , 

2  RANG(8) ,RLANG(8) ,S(30,8) ,FRNUM(8) ,VFS(8) 

COMMON  /GEOM/  X ,NSTATH ,Y ,2 .NOFSET ,LPP, BEAM , DRAFT ,LCF , 

1  VCG , GK , DELGK , SEBLA , KPITCH , KROLL , K VAU . KY AURL . AWP . VCB . FBDX . FBDY , 

2  FBDZ , NFREBD , XPT , YPT , ZPT , NPTS , LCB , GML , ASTAT , BSTAT , TITLE . MASS , 

2  DIFPLM , IPITCH , IROLL , lYAW , lYAWRL, CHEAVE , CP ITCH , CHEAPI , CROLL , 
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2  AREAMX , WSURF .GIRTH , FBDZV .DBLWL ,TLCB 
INTEGER  NSTATN , H0FSET(26 ) , NFREBD . NPTS 
CHARACTER*4  TITLE(20)  ^ 

REAL  X(25) ,Y( 10 .25) .Z(10 .25) .FBDZV^8 . 10) .LPP .BEAM . DBLWL, TLCB 
2  DRAFT , LCF , VCG , GM , DELGM , NEBLA , KPITCH . KROLL , KYAW , KY AWRL , AWP , VCB , 

2  FBDX(10),FBDY(10) ,FBDZ(10) ,XPT(10) , YPT( 10) , ZPT( 10 ) .LCB.GML, 

4  ASTAT(2S).BSTAT(26).HASS,DISPLH.IPITCH,IR0LL.IYAW, 

5  I Y AWRL , CHEAVE , CPITCH , CHEAPI , CROLL , AREAMX .WSURF , GIRTH ( 25 ) 

COMMON  /PHYSCO/  II ,TPI .PI ,PIOT, DEGRAD .RADDEG .VKMETR.METRVK , GRAY , 

2  RHO , GNU , RHOS . RHQF , GNUS . GNUF , FTMETR .PUNITS . REYSCL 
COMPLEX  II 

REAL^TPI^I , PIOT^DEGRAD .  RADDEG ,  VKMETR .METRVK  .GRAY , RHO  ,  GNU  . RHOS  , 

1  RHQF, GNUS. GNUF, FTMETR 

COMMON  /RLDBK/  PSUR(25) ,BMK{25) ,DK(25) .CAK(25) .HQ.HSPAN.HMNCHD, 

2  HAREA.HXCP,HYCP,HZCP.HGAMMA,HYHAT,HEAR,HLCS,RQ(2)  RSPAN(2) , 

2  RHNCHD(2) .RAREA(2) .RXCP(2) .RYCP(25 .RZCP(2) .RGAHHA(2) .RYHAT(2) . 

2  REAR(2),RLCSp) .SQ(2) .SSPAN (2) . SMNCHD(2) .SAREA(2) .SXCP (2) , 

2  SYCpb),SZCpb),SGAMMA(2).SYHAT(2)  SEAR(2)  SLCS(2)  BQ(2) 

2  BSPAN(25 ,BMNCHD(2) ,BAREA(2) ,BXCP(2) ,BYCP(2) ,BZCP(2) ,BGAMMA(2) , 

2  BYHAT(2) ,BEAR(2) ,BLCS(2) ,FQ(2) ,FSPAN(2)  FMNCHD(2) .FAREA(2)  , 

2  FXCP(2) ,FYCP(2) ,FZCP(2) ,FGAMMA(2) ,FYHAT(2) ,FEAR(2) ,FLCS(2) , 

2  PQ(2,2) ,PSPAN(2,2) ,PMNCHD(2 , 2) ,PAREA(2 ,2) .PXCP(2 , 2) .PYCP(2 , 2) , 

2  PZCP(2,2),PGAMMA(2,2),PYHAT(2,2).PEAR(2,2),PLCS(2.25, 

2  STADMP(1o5,SHPDMP(10,8),ENCON,WPHI,TPHI,WMELM(4,9)  SFELH(4,9,8) 

2  REELM(4,9,8) .PEELM(4,9,8) .FEELH(4.9,8) ,HEELM(4, 9 ,8) ,BpLM(4, 9 ,8) , 
2  ENWM.ENSF^e.e) .ENRE(8) ,ENPE(8) .£NFE{8) .ENHE(8) ,ENBEC8) , 

2  ENEMY(8.8) ,ENRL(8) ,ENPL(8) .ENFL(8) ,ENHL(8) .ENSL(8) ,ENBL(8) , 

2  ENSHP(8,8)  ,RELM(4.9) ,ITS(2S) .RD(2S) .EDDY(8 .25) .RGB(25) 

REAL  RDBLK(2692) 

EQUIYALENCE  (PSUR( 1 ) , RDBLK( 1 ) ) 

REAL  LCS.MCHORD 

Q  =  1 

GAMMA  =  -  90 
ORG  =  YCG  +  DRAFT 
SPAN  =  DRAFT 
MCHORD  =  LPP 

ar«a 

AREA  =  SPAN^-HCHORD 


center  ol  pressure 

ss  =  o 
SP  =  o 

DO  6  L=l, NSTATN 

(L  .EQ.  1)  DX  =  (XC2)  -  X(l))/2 
(L  .EO.  NSTATN)  DX  =  (X(NSTATN) 
(L.GT.l  .AND.  L.LT. NSTATN)  DX  = 
DX  =  ABS(DX) 

NPT  =  NOFSET(L) 

IF  (NPT  .LT.  2)  GO  TO  5 
T  =  ABSCZCl.D) 

A  =  T*DX 
SP  =  SP  +  A 
SS  =  SS  +  X(L)+A 
CONTINUE 
XCP  =  SS/SP 
YCP  =  O.O 
ZCP  =  O.O 


-  X(NSTATN-l))/2 
(X(L+1)  -  X(L-l))/2 


moment  arm 

GAM  =  GAMMA*DEGRAD 

YHAT  =  YGP*COS(GAM)  +  ZCP+SIN(GAM) 


effective  aspect  ratio 
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EAR  =  2+SPAN/MCHORD 


+  lilt  curve  slope 

LCS  =  (PI/2)+EAR 
HQ  =  q 

HSPAN  =  SPAN 
HMNCHD  =  MCKORD 
HAREA  =  AREA 
HXCP  =  XCP 
HYCP  =  YCP 
HZCP  =  2CF 
HGAMMA  =  GAMMA 
HYHAT  =  YHAT 
HEAR  =  EAR 
HLCS  =  LCS 

EN  =  Q+(RH0/2)*AREA*LCS*YHAT*YHAT*WPHI*ENC0N 
DG  10  IV=1,NVK 
ENHL(IV)  =  EN*VFS(IV) 

10  CONTINUE 

RETURN 

END 

C  DECK  HSTAT 

SUBROUTINE  HSTAT 

*  HYDROSTATIC  CALCULATIONS 

*  INPUTS 

*  X(K)  =  location  ol  station  k  (distance  lud  ol  ap)  in  meters 

*  KSTATN  =  nimber  ol  stations  in  x-array 

*  Y(J,K)  -  y-coordinate  ol  ollset  j  at  station  k 

(hall-breadth)  in  meters 

Z(J,K)  =  2-coordinato  ol  ollset  j  at  station  k 

(distance  irom  saterline,  negative  down)  in  metres 
H0FSET(K)=  number  ol  ollsets  given  lor  station  k 

NOTE 

first  station  must  be  at  stern,  last  station  at  bov 
first  offset  must  be  at  keel,  last  offset  at  waterline 


COMMON  /DATINP/  OPTN,MOTN,BSCFIL,VLACPR.RAOPR,RLDMPR,DISPLMT, 

2  LRA0PR.ADRPR,0RG0PTN,GMN0M,KG,STATK(26) ,NS0FST(25), 

2  NLEWF( 26 ) , HLFBTH (10,26), WTRLNE( 10,26), BLEUF ( 25 ) , TLEWF (25 ) , 

2  AREALF ( 26 ) , NPTLOC , PTNUMB (10), PTN AME , XPTLOC (10), YPTLOC ( 10 ) , 

2  ZPTLOC(IO) ,*BB,FBNUMB(10),FBNAME,XPTFBD(10) ,YPTFBD(10) , 

2  ZPTFBD ( 10 ) , FBCODE ( 10 ) , FBTYPE , RDOT ( 10 ) , VKDES , FNDES , 

2  STATKM.STATIS 

CHARACTERe4  PTNAME(8,10) ,FBKAME(8 , 10) ,STATHM(5) ,FBTYPE(3 , 10) 
INTEGER  OPTN , MOTN , BSCFIL , VLACPR , RAOPR , ADRPR , RLDMPR , FBCODE , 

2  FBNUMB, PTNUMB, ORGOPTN 
REAL  KG 

COMMON  /GEOH/  X,NSTATN,Y,Z,NOFSET.LPP, BEAK, DRAFT, LCF, 

1  VCG , GM ,DELGM , HEBLA , KPITCH , KRQLL ,KYAW ,KYAWRL , AWP . VCB , FBDX , FBDY , 

2  FBDZ , HFREBD , XPT , YPT , ZPT , NPTS , LCB , GML , ASTAT , BSTAT , TITLE , M ASS , 

2  DISPLM , IPITCH , IROLL , lYAW , I YAWRL , CHEAVE , CPITCH , CHEAPI , CROLL . 

2  AREAMX , WSURF , GIRTH , FBDZV ,DBLWL ,TLCB 

INTEGER  NSTATN,N0FSET(25) , HFREBD, NPTS 
CHARACTER'*>4  TITLE  (20) 

REAL  X(26) ,Y(10,26),Z(10,26).FBDZV(8,10),LPP,BEAM,DBLVL,TLCB. 

2  DRAFT , LCF , VCG , GM.DELGM , HEBLA , KPITCH ,KROLL, KY AW ,KYAWRL ,AHP , VCB , 
2  FBDX(10),FBDY(10) .FBDZ(IO) ,XPT(10) ,YPT(10) ,ZPT(10) ,LCB,GHL, 

4  ASTAT(26),BSTAT(26),MASS,DISPLM, IPITCH, IROLL, lYAW, 

6  I YAWRL , CHEAVE , CPITCH , CHEAPI , CROLL , AREAMX , WSURF , G IRTH ( 26 ) 

COMMON  /IQ/  SY5FIL ,F0TFIL , CCrriL,LCOFIL,IC*RD,TEXFIL , IPP.IN , 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL ,RMSFIL , SEVFIL , SPDFIL , 
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2  SPTFIL,LACFIL,l.AEFIL 

INTEGER  SYSFIL.POTFIL.CQFFIL.LCOFIL.ICARD.TEXFIL.IPRIN, 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL . RAOFIL .RMSFIL , SEVFIL , rPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /LOADS/  NLOADS ,SWGHT(25) .SMASS(25) , XLDSTNC 10) , XLDXPT(25) , 
2  LSTATN(25) 

COMMON  /PHYSCO/  II ,TPI , PI . PIOT , DEGRAD .RADDEG , VKMETR , METRVK , GRAV , 
2  RHO , GNU , RHOS , RHOF , GNUS , GNUF , FTMETR .PUNITS , REYSCL 
COMPLEX  II 

CHARACTER*^  PUNITS(2) 

REAL  TPI , PI , PIOT , DEGRAD , RADDEG , VKMETR , METRVK , GRAV , RHO , GNU , RHOS , 

1  RHOF, GNUS, GNUF, FTMETR 

COMMON  /SMP3YS/  FIS, AS, SIS, SOS, SDS, HALOS, DEV. PRN,SMPPS,SMPIS, 

2  SMPOS , SMPDS , SHPTYPS , SHIPS .VARS , CYCLS , TITLES , OPTION , LSIS , LSOS . 

2  LSDS , LHALOS , LDEV . LPRN , LSKPPS .LSKPIS .LSMPOS .LSMPDS , LSHPTYPS , 

2  LSHIPS.LTITLES 
CHARACTER*160  AS 

CHARACTER*80  FIS , SIS . SOS , SDS .TITLES 

CH ARACTER*20  HALOS . DEV , PRN , SMPPS , SMPIS .SMPOS , SMPDS , SHPTYPS 
CHARACTER  SHIPS+6 , VARS+2 ,CYCLS+2 
INTEGER+2  OPTION 

COMMON  /TWOD/  YY ,  22.  ENN ,  ISTA 
INTEGER  ISTA 

REAL  YY(10. 25), 22(10,25) ,ENN(4, 10.25) 

COMMON  /WGHTS/  WTDL.NQRH 
REAL  WTDL(10,26) ,N0RM(4,10,25) 

REAL  MX.IXX.IYY 

DIMENSION  P(2.10) ,NDI(2) ,ENDI(2,2) ,CC(14) ,PSPL(2,70) ,SEGS(8,69) , 
2  ELEMS(4,24). 

XHT(25).  2MT(2E).  BEE(25).  XB(2S),  XXBC25) . 
PSEGS(8,9,25) 

CHARACTER*4  METER 

DATA  METER  /‘METE’/ 

DATA  NDI,  ENDI  /  2*1,  4  *  0.0  / 

DATA  ZERO,  ONE,  TWO  /  0.0,  1.0,  2.0  / 

AREAMX  =  ZERO 
DO  60  K=1,HSTATH 
KP  s  KOFSET(K) 

IF  (NP  .GT.  1)  GO  TO  10 
ASTAT(K)  =  ZERO 
ZMT(K)  -  ZERO 

GO  TO  40 
10  CONTINUE 

SS  =  HP  -  1 
DO  20  J=1,HP 
P(l.J)  =  Y(J.K) 

P(2.J)  =  Z(J,K) 

20  CONTINUE 

CALL  SPLNT2  (PSEGSCl , 1 ,K)  ,  P.  NP,  NDI,  ENDI) 

CALL  SPINT2  (PSEGSCl , 1 ,K) ,  NS,  AREA.  1,  ZERO,  NS,  ONE.  0) 
ASTAT(K)  =  TWO  ♦  AREA 

IF  (ASTAT(K)  .GT.  AREAMX)  AREAMX  =  ASTAT(K) 

L  =  0 

DO  30  J=1,NS 

CALL  CUBC02  (PSEGSCl , J ,K) ,CC) 

NT  --  7 

DT  =  l./(KT-l) 

DO  26  1=1, NT 
L  =  L  +  1 
T  =  (I-D^DT 
T2  =  T*T 
T3  =  TfT2 

YSPL  =  CCCi/'-TS  +  CC(3)-T2  4  CC(S)4:T  4  CC{7) 

ZSPL  =  CC(2)*T3  +  CC(4)'»T2  +  CC(6)*T  +  CC(8) 
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PSPL(1,L)  =  YSPL*ZSPL 
PSPL(2,L)  =  ZSPL 
25  COKTINUE 
30  CONTINUE 

CALL  SPLNT2  (SEGS.PSPL.L.NDI ,ENDI) 

CALL  SPINT2  (SEGS ,L-1 , AREA , 1 ,2ER0.L-1 ,QNE,0) 

ZMT(K)  =  TWO  ♦  AREA 
40  COKTINUE 

BSTAT(K)  =  TWO  ♦  Y(NP,K) 

BBB(K)  =  Y(NP,K)**3 
XMT(K)  =  ASTAT(K)  *  X(K) 

SO  CONTINUE 

*  PSEGSCl,J,K)  =  parametric  spline  segment  representing  station  k 

*  (  I  =  1.  8  )  (  J  =  1,  N0FSET(K)-1  ) 

*  BSTAT(K)  =  full  beam  of  station  k  at  waterplane  in  m 

*  ASTAT(K)  =  area  of  station  k  in  m**2 

*  ZMT(K)  =  moment  of  sta.k  area  about  wp  in  m*t3 

*  XMT(K)  =  moment  of  sta.k  area  about  fp  in  m+»3 

NS  =  KSTATN 

CALL  SPFIT  (X,  ASTAT,  ELEMS .  NS) 

CALL  SPINTG  (X(l)  ,  X{NS)  .  X,  NS,  ELEMS.  ZERO.  NEBLA,  DUMMY) 

CALL  SPFIT  (X,  XMT,  ELEMS,  NS) 

CALL  SPINTG  (X(l)  ,  X(NS),  X,  NS,  ELEMS.  ZERO.  XXMT,  DUMMY) 

CALL  SPFIT  (X.  ZMT,  ELEMS,  NS) 

CALL  SPINTG  (X(l),  X(NS),  X,  NS.  ELEMS,  ZERO,  ZZHT,  DUMMY) 

*  NEBLA  =  displaced  volume  in  m**3 

*  XXMT  =  moment  of  di&pl.  vol.  about  ap  in  m'»*4 
ZZMT  =  moment  of  displ.  vol.  about  up  in  m**4 

LCB  =  LPP  -  XXMT/NEBLA 
VCB  =  ZZMT  /  NEBLA 

*  LCB  =  longitudinal  center  of  buoyancy  in  m 

*  (distance  from  fp,  positive  alt) 

e  VCB  =  vertical  center  of  buoyancy  in  m 

*  (distance  from  up,  negative  down) 

«  find  local  draft  at  Icb  (necessary  for  trimmed  ship) 

STASPC  =  LPP/20 

SLCB  =  LCB/STASPC 

DO  240  I=i.NSTATN 

IF  (STATN(I)  .LT.  SLCB)  GO  TO  240 

SDIS  "  SLCB  STATN(I“1) 

SLOPE  =  (WTRLNE(1,I)  -  WTRLNE( 1 , I-l) )  /  (STATH(I)  -  STATN(I-l)) 
TLCB  =  DBLWL  -  (WTRLNE(l ,1-1 )  +  SDIS*SLOPE) 

GO  TO  260 
240  CONTINUE 

250  IF  (KPTLOC  .EQ-  0)  GO  TO  270 
DO  260  I=i,NPfs 
XPT(I)  =  XPT(I)  -  (LPP-LCB) 

260  CONTINUE 

270  IF  (NFREBD  .EQ.  0)  GO  TO  290 
DO  280  1=1, NFREBD 
FBDX(I)  =  FBDX(I)  -  (LPP-LCB) 

280  CONTINUE 
call  TRIM 
290  CONTINUE 

transform  origin  of  z-axis  to  LCB 

DO  IBO  K=1,NSTATH 
X(K)  =  X(K)  -  (LPP-LCB) 

XB(K)  =  X(K)  ♦  BSTAT(K) 

XXB(K)  =  X(K)  *  XB(K) 

150  CONTINUE 

»  X(K)  =  distance  of  station  k  from  LCB  (negative  alt)  in  meters 
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CALL  SPFIT  (X,  BSTAT,  ELEMS, 
CALL  SPINTG  (X(l),  X(NS),  X, 
CALL  SPFIT  (X,  B6B.  ELEMS, 
CALL  SPIHTG  (X(l).  X(IJS)  ,  X, 
IVY  =  TWO  ♦  lYY  /  3. 

BM  =  lYY  /  NEBLA 


NS) 

NS, 

NS) 

NS, 

ELEMS , 

ZERO, 

AWP, 

DUMMY) 

ELEMS , 

ZERO, 

lYY, 

DUMMY) 

♦  KG  is  the  distance  from  the  keel  to  the  center  of  gravity 

♦  at  the  LCE 


KG  =  KG  +  DELGM 
VCG  =  KG  -  TLCB 
BG  =  VCG  -  VCB 
GM  =  BM  -  BG 

*  AWP  =  area  of  saterplane  in  m**2 

*  lYY  =  transverse  moment  of  inertia  of  wp  in  in**4 

*  BM  =  center  of  buoyancy  to  transverse  metacenter  in  meters 

*  GM  =  transverse  metacentric  height  in  meters 

CALL  SPFIT  (X,  XB,  ELEMS,  NS) 

CALL  SPINTG  (X(l),  X(HS),  X,  NS,  ELEMS,  ZERO,  MX,  DUMMY) 

CALL  SPFIT  (X,  XXB,  ELEMS,  NS) 

CALL  SPINTG  (X(l),  X(NS),  X,  NS,  ELEMS,  ZERO,  IXX,  DUMMY) 

BML  =  IXX  /  NEBLA 
GHL  =  BML  -  BG 
LCF  =  LCB  -  MX/AWP 

*  MX  =  longitudinal  moment  of  up  about  Icb  in  m**3 

*  IXX  =  longitudinal  moment  of  inertia  of  up  in  m**4 

*  BML  =  canter  of  buoyancy  to  longitudinal  metacenter  in  m 

*  GML  =  longitudinal  metacentric  height  in  m 

*  LCF  =  longitudinal  center  of  flotation  in  m 

*  (distance  from  fp,  positive  aft) 

*  mass,  displacement  and  moment  of  inertia  definitions 

*  roll  moment  of  inertia  is  about  the  LCG  in  the  waterplane 

*  roll  radius  of  gyration  is  about  the  VCG 

MASS  =  RFiOeNEBLA 

DISPLM  =  MASS*GRAV 

IPITCH  =  MASS*(KPITCH*LPP)**2 

IROLL  =  MASS*((KR0LLeBEAM)e*2  +  VCG**2) 

lYAW  =  MASSe(KYAW*LPP)e*2 

lYAWRL  =  llASS»(KYAWRL*LFP*e2) 

*  restoring  definitions 

CHEAVE  =  RHO*GRAV*AUP 

CPITCH  =  DISPLMeGML 

CHEAPI  =  -  RHO*GRAV*AWP*(LCB-LCF) 

*  note  that  LCB  and  LCF  are  measured  from  the  fp,  pos  aft 

CROLL  =  DISPLM*GM 
CALL  NORMAL  (PSEGS) 

CALL  N0RMT6  (PSEGS) 

DO  60  K=1,BSTATB 
BP  =  B0FSET{K) 

IF  (NP  .GT.  1)  CALL  CONIWT  (WTDL( I ,K) ,PSEGS( 1 , 1 ,K) ,NP) 

60  CONTINUE 

IF  (NLOADS  .EQ.  0)  GO  TO  69 
e  obtain  locations  for  load  calculations 


DO  65  IP=1.BL0ADS 
XLS  =  XLDSTB(IP) 

N1  =  NSTATN  -  1 
DO  63  K=1,B1 

IF  (.NOT.  (XLS.GE.STATN(K)  -AND.  XLS .LT. STATN(K+1 ) ) )  GO  TO  63 
XLDSTH(IP)  =  0.5*(STATN(K)  +  STATN(K+1;) 

GO  TO  64 
63  CONTINUE 
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64  XlDXPTCIP)  =  LCB  -  XLDSTN(IP)*LPP/20 
LSTATN(IP)  =  NSTATN  +  1  -  K 

65  CONTINUE 

*  compute  section  mass 

L  =  NSTATN  +  1 
DO  68  K=l, NSTATN 
L  =  L  -  1 

IF  (PUNITS(l)  .EQ.  METER)  SMASSfL)  =  SWGHT(K)*1000 
IF  (PUNITS(l)  .NE.  METER)  SMASS(L)  =  SWGHT(K)»2240/GRAV 

68  CONTINUE 

69  CONTINUE 

calculation  of  vetted  surface 

NS  =  NSTATN 
DO  80  K=l, NSTATN 
NP  =  NDFSET(K) 

GIRTH(K)  =  ZERO 

IF  (NP  .LT.  2)  GO  TO  80 

DO  70  J=1,NP 

GIRTH(K)  =  GIRTH(K)  +  WTDL(J.K) 

70  CONTINUE 

GIRTH(K)  =  TWO  ♦  GIRTH(K) 

80  CONTINUE 

CALL  SPFIT  (X,  GIRTH,  ELEMS ,  NS) 

CALL  SPINTG  (X(l),  X(NS) ,  X,  NS,  ELEMS.  ZERO,  WSURF,  DUMMY) 

*  vrite  offsets  to  HPLFIL  for  graphics 

CALL  SPLNFT 

*  write  scratch  file 

FIS  =  SDS(1:LSDS)//' .SCR' 

OPEN  (UNIT=SCRFIL, F1LE=FIS.F0RM= 'UNFORMATTED ’ ,STATUS= 'UNKNOWN') 

WRITE  (SCRFIL)  YY.ZZ.ENN.ISTA 
WRITE  (SCRFIL)  WTDL.NORM 

CLOSE  (UMIT=SCRFIL) 

RETURN 

END 

C  DECK  HSTOUT 

SUBROUTINE  HSTOUT 

COMMON  /APPEND/  IBKSET,NBKSTN(2) ,BKIMAG(2) ,BKFS(2) ,BKAS(2) . 

2  BKWD(2) ,BKSTN(10,2) ,BKHB(10,2),BKLNTH,BKWDTH, 

2  BKWL(10,2) .BKAN(n.2),HSKSET,SKIMAG(2) ,SKFLS(2) ,SKALS(2) , 

2  SKAUS(2),SKHb(2),SKFLWL(2) ,SKALWL(2) ,SKAUWL(2) .NRDSET ,RDIMAG(2) , 

2  PJ3RFS(2) ,RDRAS(2) ,RDRHB(2) .RDRFWL(2) .RDRAWL(2) ,RDTFS(2) ,RDTAS(2) , 
2  RDTHB(2),RDTFWL(2),RDTAWL(2),NSBSET,SBIMAG(2) .SDBRFS(2) ,S0BRAS(2) 
2,S0BRHB(2) ,S0BRFW(2) ,S0BRAW(2) .SIBRFS(2) ,SIBRAS(2) ,SIBRHB(2) , 

2  SIBRFW(2)  ,SIBRAW(2)  ,SB''/^v.2)  ,SBTAS(2)  ,SBTHB(2)  ,SBTFWL(2) , 

2  SBTAWL(2),IFHSET,FNIMAG(2) ,FNRFS(2) ,FNRAS(2) . 

2  FNRHB ( 2 ) , FNRFWL ( 2 ) , FNRAWL( 2 ) , FNTFS (2 ) , FNTAS ( 2 ) , FNTH3 ( 2) , 

2  FNTFWL(2) ,FNTAWL(2) .NEXPRD .ENRD0(8) ,ENRDS(8) 

COMMON  /DATINP/  0PTN,M0TK,BSCF1L,VLACPR,RA0PB,RLDMPR,DISPLMT, 

2  LRAOPR , AD RPR , ORGOPTN . GMNOM . KG , STATN ( 26 ) , KSOFST ( 25 ) , 

2  NLEWF(26),HLFBTH(10,2B) .WTRLNE(10.25) .BLEWF(2B) ,TLEWF(26), 

2  AREALF(2B) .KPTLOC ,PT»UMB(10) ,PTNAME,XPTL0C(10) .YPTLDC(IO) , 

2  ZPTLOCClO) ,NBB.FBNUHB(10),FBNAME,XPTFBD(10),YPTFBD(10). 

2  ZPTFBD(IO)  .FBCODEdO)  ,FBTYPE,RDOT(iO)  ,VKDES ,FNDES , 

2  STATNM.STATIS 

CHARACTER*4  PTNAME(8 , 10) ,FBNAME(8 , 10) ,STATNM(E ) ,FBTYPE(3 ,10) 

I HTEGER  QPTH ,  HCTH  ,  B3CFIL , VLACPR ,  R AOPR ,  ADP.PR ,  PIDMPP. .  FBCODE , 

2  FBNUMB.PTNUMB, ORGOPTN 
REAL  KG 


►0  *>0  Cn  ^  J  fO  to  K)  »-* 


COMMON  /GEOM/  X , NSTATN ,Y .Z , NOFSET ,LPP .BEAM . DRAFT . LCF 
VCG.GM.DELGM.NEBLA .KPITCH .KROLL ,KYAW .KYAWRL , AWP , VCB , FBDX ,FBDY , 
FBDZ , NFREBD . XPT , YPT , ZFT , NPTS , LCB , GML , ASTAT , BST AT , TITLE .MASS . 
DISPLM, IPITCH . IROLL , lYAW , lYAWRL , CHEAVE.CPITCH, CHEAPI , CROLL, 
AREAMX . WSURF .GIRTH , FBDZV .DBLWL .TLCB 
INTEGER  NSTATN. N0FSET(25) .NFREBD, NPTS 

REAL*X(26KYao^25)?Z(i0.25)  .  FBDZV  (8 . 10)  .LPP  .BEAM  .DBLWL  .TLCB  . 
DRAFTVlCF  VCG , GM,DELGM . NEBLA .KPITCH .KROLL  KY AW . KYAWRL , AWP .VCB . 
FBDX(io) ,FBDY(1o5 .FBDZ(IO) .XPT(IO) .YPT(lo5 .ZPTdO) .LCB. GML. 
ASTAT (26  5 . BSTAT(25 ) , MASS .DISPLM .IPITCH , IROLL . I YAW 
I YAWRL , CHEAVE , CPITCH , CHEAPI , CROLL , AREAMX , WSURF , G I RTH ( 26 ) 


COMMON  /lO/  SYSFIL.POTFIL.COFFIL.LCOFIL.lCARD.TpFIL.IPRlN, 
SCRFIL.HPLFIL.LRAFIL.ORGFIL.RAQFIL.RMSFIL.SEVFIL.SPDFIL, 

SPTFIL.LACFIL.LAEFIL  tdct., 

INTEGER  SYSFIL.POTFIL.COFFIL.LCOFIL.ICARD.TEXFIL.IPRIN . 

2  SCRFIL . HPLFIL , LRAFIL .ORGFIL , RAOFIL .RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 


COMMON  /PHYSCO/  II ,TPI ,PI , PIOT, DEGRAD , RADDEG .VKMETR .METRVK ,GRAV , 
2  RHO . GNU . RHOS . RHOF , GNUS . GNUF . FTMETR , PUN ITS , REYSCL 
COMPLEX  II 

CHARACTER *4  PUN ITS ( 2 ) 

REAL  TPI . PI , P lOT . DEGRAD . RADDEG , VKMETR , METRVK . GRA V , RHO , GNU , RHOS , 

1  RHOF. GNUS, GNUF, FTMETR 


COMMON  /STATE/  LAT  ,VRT  .LOADS  .  ADDRF.S  .SALT,  HEAD  .EXROLL .  BKEEL 
LOGICAL  LAT , VRT . LOADS . ADDRES . SALT , HEAD , EXROLL , BKEEL 


CHARACTER*4  UMETR(2) .UFEET(2) .UN1TS(2) 

DIMENSION  BKL(2) ,IBKWS(2)  ^  ^ 

DIMENSION  SKL(2),SKH(2j,lSKWS(2) 

DIMENSION  RRT(2)  .RTP(2)  .RDMSP(2KRDMCH(2)  ,IRDWS(2)  . 
DIMENSION  SB0RT(2) ,SBIRT(2) ,SBTIP(2) ,SB0MC(2) ,SB1MCI2; , 
2  SBaMS(2) ,SBIMS(2) ,ISBWS(2)  ,  ,  ^ 

DIMENSION  FRT(2) ,FTP(2) .FHMSP(2) ,FNHCH(2) ,IFNWS(2) 

REAL  LPPND .LCBND .LCFND ,KGND , GMND .KM.KMKD.KB ,KBND 
CHARACTER*4  METER. TONSM.TONSE. TON 


DATA  METER  /’METE'/ 

DATA  UMETR  / ’  MET ’ , ' ERS  ' / 

DATA  UFEET  /'  FEE’ . 'T  ’/ 

DATA  TONSM  /’  M.  ’/ 

DATA  TONSE  /’  L.  '/ 

UNITS(l)  =  UHETR(l) 

UNITS(2)  =  UMETR(2) 

TOM  =  TQNSK 

IF  (PUNITS(l)  .NE.  METER)  UNITS(l)  =  UFEET(l) 
IF  (PUNITS(l)  .KE.  METER)  UNITS(2)  =  UFEET(2) 
IF  (PUNITS(l)  .NE.  METER)  TON  =  TONSE 

LPPND  =  LPP/BEAM 
BEAMND  =  BEAM/DRAFT 
DRFTKD  =  DRAFT/BEAM 


♦  convert  displacement  Iron  mass  to  tons 


DISPLT  =  MASS*. 001 

IF  (PUCITS(l)  .NE.  METER) 

VOL  =  MASS/RHO 

DISPID  =  V0L/(0.1*LPP)**3 

IF  (PUNITS(l)  .NE.  METER) 

LCBND  =  LCB/LPP 

LCFND  =  LCF/LPP 

VCGND  =  VCG/BEAM 

KGKD  =  KG/BEAM 

CMND  -  GM/BEA.M 


DISPLT  = 


DISPHD  = 


HASS  *  GRAV  /  2240. 


DISPLT/(0.01*LPP)**3 


KM  =  KG+GM 
KMND  =  KM/BEAM 


I 

L 


KB  =  VCB  +  TLCB 
KBND  =  KB/BEAM 


vaterplane  and  «ett«d  surface 
AWPND  =  AWP/(LPP+BEAM) 

WSRFND  =  WSURF/(2.*LPP*DRAFT  +  2. »BEAM*DRAFT  +  LPP*BEAM) 
gyradii 

RGYRAD  =  KROLL*BEAM 
PGYRAD  =  KPITCH*LPP 
YGYRAD  =  KYAW^LPP 

hydrostatic  coefficients 

CB  =  KEBLA/(LPP*BEAM*DRAFT) 

CX  =  AREAMX/(BEAH»DRAFT) 

CP  =  CB/CX 


convert  design  speed  in  knots  to  froude  number 


estimated  roll  period  based  on  equation  ~ 

ROLPER  =  (TPI/SQRT(GRAV))  *  SQRT(  (RGYRAD**2+A44) /GM  ) 
where  A44  =  0 . 26'»RaYRAD**2 

ROLPER  =  (TPI/SQRT(GRAV))  ♦  sqRT(1.25*RGYRAD**2/'GM) 
ROLFRQ  =  TPI/ROLPER 
SS  =  LPP/20. 


bilge  keel 

IF  (NBKSET  .EQ.  0)  CO  TO  16 
DO  10  IBK=1,WEKSET 

BKL(IEK)  =  IBKASUBK)  -  BKFS(IBK))  ■«  SS 
IBKWS(IBK)  =  4.  ■»  BKL(IBK)  *  BKWD(IBK) 

10  COMTINUE 

skeg 

16  IF  (NSKSET  .EQ.  0)  GO  TO  26 
DO  20  ISK=1,1ISKSET 

SKLCISK)  =  (SKALS(ISK)  -  SKFLS(ISK))  •  SS 
SKH(ISK)  s  (SKAUWL(ISK)  -  SKALWL(ISK)) 
FACTOR  =1.0 

IF  (SKHB(ISK)  .GT.  0.)  FACTOR  =  2.0 
ISKWS(ISK)  =  FACTOR  ♦  SKL(ISK)  •  SKB(ISK) 
20  COMTINUE 


rudder 


25 


30 


•(IRD)  = 

(RDRAS( 

,IRD) 

-  RDRFS  ( 

:iRD); 

1  •  SS 

■(IRD)  =  ' 

(RDTAS( 

IRD) 

-  RDTFEI 

[IRD)! 

)  *  SS 

A  =  RDTHB(IRD)  -  RDRHB(IRD) 

B  --  ({RDRFWL(IRD)+RDRAyL(IRD)) 

RDMSPaRD)  =  SqBT(A*A  +  B*B) 

RDMCH(IRD)  =  (URDRAS(IRD)+RDTAS(IRD)) 

/2)  •  SS 
FACTOR  =2.0 

IF  (RDRHB(IRD)  .GT.  0.)  FACTOR  =  4.0 
IRDWS(IRD)  =  FACTOR  •  RDMSP(IRD)  •  RD«CH(IRD) 
CONTINUE 


(RDTFWL(IRD)+RDTAWL(IRD)))  /  2 


(RDRFS (IRD ) +RDTFS (IRD ) ) ) 


propeller  shaft  brackets 

36  IF  (NSBSET  .EQ.  0)  GO  TO  46 
DO  40  1SB=1. NSBSET 

SBORT(ISB)  =  (SOBRAS(ISB)  -  SOBRFS(lSB))  •  SS 
SBTIP(ISB)  =  (SBTAS(ISB)  -  SBTFS(ISB))  *  SS 


SBOHC^ISE)  =  (((S0BB.AS(ISB)+SBTAS(ISB))  -  (SOBRFSCISB)+ 

2  SBTFSCISB)))  /  2)  *  SS 

A  =  SOBRHB(ISR)  -  SBTHE(ISB) 

B  »  ((SOBRFW(ISB)+SOBRAW(ISE))  -  (SBTFWL(ISB)  +  SBTAWL(ISB) ) )  /  2 
SBOMS(lSB)  =  SQRT(A*A  +  B»B) 

FACTOR  =4.0 

ISBUS(ISB)  =  FACTOR  ♦  (SBOMS(ISB)*SBOMC(ISB) ) 

IF  (SBTHB(ISB)  .EO.  0.)  GO  TO  40 

SBIRTCISB)  =  (SIBRAS(ISB)  -  SIBRFS(ISB))  *  SS 

SBIHCnSB)  =  (((SIBRASdSBJ+SBTASdSB))  -  (SIBRFS(ISB)  + 

2  SBTFS(ISB)))  /  2)  •  SS 

A  =  SBTHB(ISB)  -  SIBRHB(ISB) 

B  =  ((SIBRFW(1SB)+SIBRAW(ISB))  -  (SBTFWL(ISB)+SBTAUL(ISB) ) )  /  2 
SBIMS(ISB)  =  SORTCA^A  +  B*B) 

ISBWS(ISB)  =  ISBWS(ISB)  +  (FACTOR  ■»  (SBIMS( ISB ) ♦SBIMCClSB ) ) ) 

40  CONTINUE 

tin 

4B  IF  (NFNSET  . EQ .  0)  CO  TO  B6 
DO  60  IFN=1, NFNSET 

FRT(IFK)  =  (FNRAS(IFN)  -  FNRFS(IFN))  ♦  SS 
FTP(IFN)  =  (FNTAS(IFN)  -  FNTFS(IFN))  *  SS 
A  =  FNTHB(IFN)  -  FNRHB(IFN) 

B  =  ((FNRFWL(IFN)+FNRAWL(IFN))  -  (FNTFWL(IFN )+FNTAWL( IFN ) ) )  /  2 
FNBSPCIFN)  =  SQRT(A*A  +  B*B) 

FNMCH(IFN)  =  ((:(FNRAS(IFN)+FNTAS(IFN))  -  (FNRFS ( IFN ) +FNTFS ( IFN ) ) ) 
2  /2)  *  SS 
FACTOR  =2.0 

IF  (FNRHB(IFN)  .GT.  0)  FACTOR  =  4.0 
IFNUS(IFN)  =  FACTOR  *  FHMSP(IFN)  *  FNMCH(IFN) 

60  CONTINUE 
66  CONTINUE 

tr&nsform  re&I  v&ri&bXes  to  int«gers 

IDISPL  =  DISPLT  -*■  .6001 
lAWP  =  AWP  +  .6001 
IWSURF  =  WSURF  ♦  .6001 

ship  particulars  tabls 

WRITE  (IPRIH.IOOO) 

WRITE  (IPRIN,1006)  (TITLE(I) ,1=1 .20) 

WRITE  (iPRIN.lOlO) 

WRITE  (IPR1N,1016) 

WRITE  (IPR1M,1020)  LPP , (UNITS(I) ,1=1 ,2) .LPPND 

WRITE  (IPRIN,1026)  BEAM , (UNITS(I) ,1=1 ,2),BEAMND 

WRITE  (IPRIN,1030)  DRAFT, (UNITS(I) .1=1 ,2) .DRFTHD 

IF  (PUNITS(l)  .NE.  METER)  WRITE  {IPRIN.1036)  DISPLT .TON .DISPND 

IF  (PUNITS(l)  .EQ,  METER)  WRITE  (IPRIN.1036)  DlSPLT .TON .DISPND 

WRITE  (IPP.IS,1G4Q)  VKDES.FNDES 

WRITE  (IPRIN.lOlO) 

WRITE  (IPRIN,104B) 

WRITE  (IPRIN,1060)  VCG, (UNITS(I) ,1=1 ,2) .VCGKD 
WRITE  (IPRIK,1066)  KG, (UNITS(I) ,1=1 ,2) .KGND 
WRITE  (IPRIN.lOeO)  GM,(UHITS(I),I=1,2),GMND 
WRITE  (IPRIN,1066)  KM , (UNITSC I ) . 1=1 ,2) ,KMND 
WRITE  (IPRIB,1070)  KB , (UNITS (I) , 1=1 ,2) ,KBHD 
WRITE  (IPRIN.lOlO) 

WRITE  (IPRIN,1076) 

WRITE  (IPRIH.loeO)  LCB,(UHITS(I),I=1.2),LCBND 
WRITE  (IPRIN,1085)  LCB, (UNITS(I) ,1=1 ,2) .LCBND 
WRITE  (IPRIK,1090)  LCF, (UHITS(I ) , 1=1 ,2) .LCFND 
WRITE  (IPRIN.lOlO) 

WRITE  (IPRIN,1095) 

WRITE  (1PRIN,2000)  RGYRAD , (UN1TS(I ) ,1=1 .2) .KROLL 
WRITE  (IPRIH,2006)  PCYRAD, (UNITS(I) ,1=1 ,2) .KPITCH 
WRITE  (1PRIN.2010)  YGYRAD , (UHITS(l) . 1=1 .2) ,KYAW 
WRITE  (IPRIN,2016)  ROLPER , ROLFRQ 
WKllE  (iPftiH , iOiO) 

WRITE  (IPRIN,2020) 


WRITE  (;iPRIN,2025)  AWP ,  (UNITS(l)  ,  1=1 ,2)  , AWPND 
WRITE  (IPRIN,2030)  WSURF,  (OMITSd)  .1  =  1 .2)  .WSRFND 
WRITE  (IPRIN.lOlO) 

WRITE  aPRIN.2040) 

WRITE  aPRIN.2045)  CB.CX.CP 
WRITE  (IPRIN,2050) 

•***  appendage  part icularc  table  **•* 


100 


110 


120 


122 

12S 


130 


140 


WRITE  flPRIH.lOOO) 
WRITE  <;iPRIN,2999; 
WRITE  (IPRIB.lOlO) 
IF  (NEKSET  .EQ.  0) 
WRITE  (IPRIN,3000) 
WRITE  (IPRIN.3005) 
IF  (NBKSET  .EQ.  2) 
WRITE  (IPRIR.3015) 
IF  (NBKSET  .EQ.  2) 
WRITE  (IPRIN,3020) 
IF  (NBKSET  .EQ.  2) 
WRITE  (IPRIN.lOlO) 
IF  (NSKSET  .EQ.  0) 
WRITE  (IPRIN,3030) 
WRITE  (IPRIN.3035) 
IF  (NSKSET  .EQ.  2) 
WRITE  (IPRIN.3046) 
IF  (NSKSET  .EQ.  2) 
WRITE  (IPRIN,306E) 
IF  (NSKSET  .EQ.  2) 
WRITE  (IPRIN.lOlO) 
IF  (NRDSET  .EQ.  0) 
WRITE  (1PRIN,3066) 
WRITE  (IPRIN.3070) 
IF  (NRDSET  .EQ.  2) 
WRITE  (IPRIN.3080) 
IF  (NRDSET  .EQ.  2) 
WRITE  (IPRIN.3090) 
IF  (NRDSET  .EQ.  2) 
WRITE  (IPRIN.3100) 
IF  (NRDSET  .EQ.  2) 
WRITE  (IPRIN.lOlO) 
IF  (NSBSET  .EQ.  oj 
WRITE  (IPRIN,3110) 
WRITE  (IPRIM.3116) 
IF  (NSBSET  .EQ.  2) 
WRITE  (IPRIN.3146) 
IF  (NS3SET  .EQ.  2) 
WRITE  (IPRIN.3135) 
IF  (NSBSET  .EQ.  2) 
IF  (SBTHPd)  .EQ.O. 
IF  (SBTRB(l).Eq.O. 
WRITE  (IPRIN,3126} 
IF  (NSBSET  .EQ.  2) 
WRITE  (IPRIH.3166) 
IF  (NSBSET  .EQ.  2) 
CO  TO  125 

WRITE  (IPRIN.3126) 
WRITE  (IPRIH.3166) 
WRITE  (IPRIN.3166' 
IF  (NSBSET  .EQ.  2> 
WRITE  (IPRIN.lOlO) 
IF  (NFNSET  .EQ.  O) 
WRITE  (IFRIH,3176) 
WRITE  (IPRIN.3180) 
IF  (NFNSET  .EQ.  2) 
WRITE  (IPRIN.3190) 
IF  (NFNSET  .EQ.  2) 
WRITE  (IPRIN.3200) 
IF  (NFNSET  -EQ.  2) 

WRITE  (IPRIH,3210) 

'  -  -  \ 

M/ 


CONTINUE 


(TlTLF.d)  .1=1,20) 

GO  TO  100 

BKL(l)  ,(UNITS(I),I=1.2)  ,  , 

WRITEdPP.IN,30105  BKL(2)  .  (UNITS(I)  ,1=1 ,2) 
BKWD(l),(IJNITSd).I  =  1.2)  ^  ....v  .  . 

WRITEdPKIN.SOlO)  BKWD(2)  ,  (UKITSd)  ,1  =  1  ,2) 
IBKWS(l),(UNITSd),I=1.2i 

WRITE(IPRIN,302B)  IBKW£(2)  ,  (UNITSd)  ,  1  =  1 , 2) 
GO  TO  no 

SKLCd, (UNITSd), 1=1. 2)  ^  ^ 

WRITEdPRIN, 3040)  SKL(2)  ,  (UNITSd ) ,  1=1 , 2) 
SKH(l)  .(UNITSd), 1=1, 2) 

WRITEdPRIN. 305o5  SKH(2)  ,  (UNITS(I ) .  1=1 , 2) 
ISKWS(l). (UNITSd), 1  =  1, 2) 

WRITEdPRIN. 3060)  ISKUS(2)  ,  (UNITS(I)  ,1  =  1, ,:.) 
GO  TO  120 

RRT(l).  (UNITSd), 1=1, 2)  ,  ^ 

WRITEdPRIN. 3075)  RRT(2)  ,  lU!JITS(I)  ,1=1 .2) 
RTP(1).(UNITS(I),I=1,2)^  _ 

WRITEdPRIN, 307.5)  RTP(2)  .  (UNITSd)  ,1=1 .2) 
RDHSPd),(UNITS(i).I=1.2) 

WRITEdPRIN, 3095)  RDMSP(2) ,  (UNITSd)  ,1=1 ,2) 
IRDWSd), (UNITSd), 1=1, 2)  ^ 

WRITEdPRIN, 3106)  1RDWS(2)  ,  (UHITS(I)  ,1=1,2) 

GO  TO  130 

SBORT(l).  (UNITSd), 1=1, 2)  ,  ^ 

WRITEdPRIN, 3120)  SB0RT(2)  ,  (UNITS(I)  ,  1=1 ,2) 
SBOMSd),  (UNITSd), 1=1, 2)  ,  s 

WRITEdPRIN ,3160)  SB0HS(2) , (UNITS(I) ,1=1 ,2) 
SBTIP(1).(UHITS(I),I=1.2) 

WRITEdPRIN, 3140)  SBTIP(2)  .  (UNITS(I)  ,1=1,2) 
.AND.  NSBSET. EQ.l)  SO  TO  125 
.AND.  NSBSET. EQ. 2)  GO  TO  122 
SRIRT(l)  .(UNITSd)  ,1=1 .2) 

WRITEdPRIN  ,3120)  SBIRT(2)  .  (UNITSd)  ,1=1 ,2) 
SBIMS(l),(UHITS(I).I=l,2) 

WRITEdPRIN, 3160)  SBIMS(2)  ,  (UNITSCD  .1=1,2) 

SBIRT(2) ,  (UNITSd)  .1=1,2) 

SBIMS(2) , (UHITS(I) ,1=1,2) 

ISBWS(l) , (UNITS(I) ,1=1,2) 

WRITEdPRIN, 3170)  ISEWS(2)  ,  (UNITS(I) ,  1=1 ,2) 
GO  TO  140 

FRT(l)  .(UNITSd), 1=1, 2) 

WRITEdPRIN, 3186)  FRT(2)  ,  (UNITS(I)  ,1=1,2) 
FTP(l)  , (UNITSd), 1=1, 2) 

WRITEdPRIN, 3186)  FTP(2)  ,  (UNITSd)  ,1=1,2) 
FNMSP(l) , (UNITS(l) ,1=1 ,2)  ,  ^ 

WRITEdPRIN. 3206)  FNMSP(2)  .  (UNITS(I)  ,  1  =  1 . 2) 
lFNWSd).(UNXTS(I).I=l,2) 

WidTEClP?vIN,3215)  IFHHS(2)  ,(TINITS(T)  ,7  =  ^.7) 


I 
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WRITE  (IPRIN,3300) 

1000  FORMAT  (IHl) 

1005  FORMAT  ( IHO , IX , 20A4//28X ,2SHTABLE  OF  SHIP  PARTICULARS) 

1010  FORMAT  (/) 

1015  FORMAT  (10X,22HSHIP  CHARACTERISTICS  -,/) 

1020  FORMAT  (10X,24H  SHIP  LENGTH  (LPP)  ,  F7.2,2A4, 

2  4X,12HLENGTH/BEAH  ,7X,F7.3) 

1025  FORMAT  (10X,25H  BEAM  AT  MIDSHIPS  ,F6.2,2A4, 

2  4X, 12HBEAM/DRAFT  ,7X.F7.3) 

1030  FORMAT  (10X,26H  DRAFT  AT  MIDSHIPS  .F6.2.2A4. 

2  4X,12HDRAFT/BEAK  ,7X,F7.3) 

1035  FORMAT  (10X,23H  DISPLACEMENT  (S.W.)  . F8 . 1 , A4 , 4HT0NS , 

2  4X,17HDISPL/( .01LPP)**3,1X,F8.3) 

1036  FORMAT  (10X,23H  DISPLACEMENT  (S.W.)  ,F8 . 1 , A4 , 4HT0NS ,4X , 

2  17HV0LUME/(.1LPP)*^3,1X,F8.3) 

1040  FORMAT  (10X,25H  DESIGN  SHIP  SPEED  .F6.2,8H  KNOTS  , 

2  4X,13HFR0UDE  NUMBER, 6X,F7. 3) 

1045  FORMAT  (lOX .20HVERTICAL  LOCATIONS  -,/) 

1050  FORMAT  (10X,25H  C.  OF  GRAVITY  (VCG)*  ,F6.2,2A4. 

2  4X,12HVCG/BEAH  ,7X,F7.3) 

1056  FORMAT  (10X.26H  C.  OF  GRAVITY  (KG)**  .F6.2,2A4, 

2  4X,  12HKG/BEAM  .,7X,F7.3) 

1060  FORMAT  (10X,2EH  METACENTRIC  HT.  (GM)  ,F6.2.2A4, 

2  4X, i2HGM/BEAM  ,7X,F7.3) 

1065  FORMAT  (10X,25K  METACENTER  (KM)**  ,F6.2,2A4, 

2  4X.12HKM/BEAM  ,7X.F7.3) 

1070  FORMAT  (10X,26E  C.  OF  BUOYANCY  (KB)**  ,F6.2,2A4, 

2  4X,12HKB/BEAH  .7X,F7.3) 

1075  FORMAT  (lOX .27HL0NGITUDIHAL  LOCATIONS***  -,/) 

1080  FORMAT  (10X.25H  C.  OF  GRAVITY  (LCG)  .F6.2,2A4, 

2  4X,12HLCG/LENGTH  ,7X,F7.3) 

1085  FORMAT  (10X.25H  C.  OF  BUOYANCY  (LCB)  ,F6.2,2A4, 

2  4X,12HLCB/LENGTH  ,7X.F7.3) 

1090  FORMAT  (10X,26H  C.  OF  FLOTATION  (LCF)  ,F6.2,2A4, 

2  4X,12HLCF/LENGTH  ,7X,F7.3) 

1095  FORMAT  (10X,24HMOTION  CHARACTERISTICS  -,/) 

2000  FORMAT  (10X.26H  ROLL  GYRADIUS  ,F6.2.2A4, 

2  4X,12HRG/BEAM  ,7X,F7.3) 

2005  FORMAT  (10X.2EH  PITCH  GYRADIUS  ,F6.2,2A4, 

2  4X,12EPG/LPP  .7X,F7.3) 

2010  FORMAT  (10X,2BH  YAW  GYRADIUS  .F6.2,2A4, 

2  4X,12HYG/LPP  ,7X,F7.3) 

2016  FORMAT  (10X,26H  ESTIMATED  ROLL  PERIOD  ,F6.2,8H  SECONDS, 

2  4X,19HR0LL  FREQ  (RADIANS) ,F7 . 3) 

2020  FORMAT  (lOX , 16HC0MPUTED  AREAS  -,/) 

2026  FORMAT  (10X,23H  WATERPLANE  ,F8. 1,4H  SQ. ,2A4, 

2  14HAWP/(LPP*BEAM) ,6X,F7.3) 

2030  FORMAT  (10X,23H  WETTFJ3  SURFACE,  HULL  ,F8  1,4H  SQ.,2A4, 

2  15HWS/(2LD+2BD+LB) ,4X,F7.3) 

2040  FORMAT  (10X,19HHULL  COEFFICIENTS  -,/j 

2046  FORMAT  (10X,26H  BLOCK  (CB)  ,F6.3./ 

2  10X.26H  SECTION  (CX)  .F6.3,/ 

3  10X,25H  PRISMATIC  (CP)  ,F6.3) 

2060  FORMAT  (1H0,/10X,22H*  WATERLINE  REFERENCE, 

2  /10X,17H**  KEEL  REFERENCE, 

2  /10X,17H***F.P.  REFERENCE) 

2999  FORMAT  (1H0,1X,20A4//23X,3BHTABLE  OF  SHIP  APPENDAGE  PARTICULARS) 

3000  FORMAT  (10X,28HBILGE  KEEL  CHARACTERISTICS  -,/) 

3005  FORMAT  (12X,29HBILGE  KEEL  LENGTH  (SET  HO.  l) ,20X,F7.2,2A4) 

3010  FORMAT  (30X,11H (SET  NO.  2) .20X,F7.2,2A4) 

3016  FORMAT  (12X,29HBILGE  KEEL  WIDTH  (SET  NO.  1) ,20X,F7.2,2A4) 

3020  FORMAT  (12X,42HT0TAL  WETTED  SURFACE  AREA  (B.K.  SET  NO.  1),7X,I7, 
2  4H  Sq. ,2A4) 

3026  FORMAT  (38X,  16H(E  .K.  SET  HO.  2),7X,I7,4H  S(;|.,2A4) 

3030  FOiMAT  (10X,22HSKEG  CHARACTERISTICS  -,/) 

3036  FORMAT  (12X,34HSKEG  LENGTH  Al.ONG  KEEL  (SET  HD.  1) ,  1BX,F7 .2,2A4) 
3040  FORMAT  (36X,11H(SET  NO.  2) ,13X,F7.2,2A4) 

3046  FORMAT  (12X,23HSKEG  HEIGHT  (SET  NO.  1) ,26X,F7 .2,2A4) 

3060  FORMAT  (24X.11H(SET  NO.  2) ,26X .F7 .2,2A4) 

3066  FORMAT  (12X ,42HT0TAL  WETTED  SURFACE  AREA  (SKEG  SET  NO.  1),7X,I7, 

AfJ  CD 

3060“  format’ (38X,16H( SKEG  SET  NO.  2),7X,I7,4H  SQ. ,2A4) 
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3065 

3070 

3075 

3080 

3090 

3095 

3100 

2 

3105 

3110 

3115 

2 

3120 

3126 

2 

3126 

2 

3135 

2 

3140 

3145 

2 

3150 

3166^ 

3156^ 

3165" 

3170" 

3176 

3180 

3165 

3190 

3200 

3206 

3210 

2 

3215 

3300 


FORMAT  (;i0X,24HRUDDER  CHARACTERISTICS  -,/) 

FORMAT  (12X,36HRUDDER  ROOT  CHORD  LENGTH  (SET  NO.  1) , 13X , F 7 . 2 , 2 A4) 
FORMAT  (37X,11H(SET  NO.  2)  ,  13X  ,F7 . 2.2A4)  ^ 

FORMAT  (12X,36HRUDDER  TIP  CHORD  LENGTH  (SET  NO.  1 ) , 13X , F7 . 2 , 2A4) 
FORMAT  (12X,28HRUDDER  MEAN  SPAN  (SET  NO.  1) ,21X,F7.2,2A4) 

FORMAT  (29X,11H(SET  HO.  2).  21X ,F7 . 2,2A4) 

FORMAT  (12X,44HT0TAL  WETTED  SURFACE  AREA  (RUDDER  SET  NO.  1),5X, 
17, 4H  SO. ,2A4)  ^ 

FORMAT  (38X,18H( RUDDER  SET  NO.  2).6X.I7.4H  SQ.,2A4) 

FORMAT  (10X,42HPR0PELLER  SHAFT  BRACKETS  CHARACTERISTICS  -,/) 
FORMAT  (12X,45H0UTSIDE  BRACKET  ROOT  CHORD  LENGTH  (SET  NO.  1K4X, 
F7  2  2A4) 

FORMAT  (46X.11H(SET  NO.  2) ,4X ,f7 . 2 .2A4)  ^ 

FORMAT  U2X,45HINSIDE  BRACKET  ROOT  CHORD  LENGTH 
F7  2  2A4) 

FORMAT  (12X.45HINSIDE  BRACKET  ROOT  CHORD  LENGTH 
F7  2  2A4) 

FORMAT  (12X.37HBRACKET  TIP  CHORD  LENGTH  (SET  HO. 

2A4) 

FORMAT 
FORMAT 
2A4) 

FORMAT  (38X,11H(SET  NO.  2) . 12X .F7 . 2 ,2A4) 

FORMAT  a2X,37HlNSIDE  BRACKET  MEAN  SPAN  (SET  NO, 

2A4) 

FORMAT  (12X,37HINSIDE  BRACKET  MEAN  SPAN  (SET  NO. 

2A4) 

FORMAT  (12X.45HTQTAL  WETTED  SURFACE  AREA  (BRACKET  SET  NO.  1),4X, 
17  -411  SO  2A4) 

FORMAT  (3SX,19H(BRACKET  SET  NO.  2),4X,I7.4H  SQ..2A4) 

FORMAT  (10X,21HFIN  CHARACTERISTICS  -,/) 

FORMAT  U2X,33HFIN  ROOT  CHORD  LENGTH  (SET  NO.  1 ) , 16X ,F7 . 2 , 2A4) 
FORMAT  (34X,11H(SET  NO.  2M6X,F7.2,2A4) 

FORMAT  a2X,33HFIN  TIP  CHOi’O  LENGTH  (SET  NO.  1 )  ,  16X  ,F7 . 2 , 2A4) 
FORMAT  (12X,26HFIN  MEAN  SPAN  (SET  NO.  1> ,24X,F7 . 2,2A-*) 

FORMAT  (26X,11H(SET  NO.  2) ,24X,F7.2,2A4)  , ^  ov 

FORMAT  a2X,41HT0TAL  WETTED  SURFACE  AREA  (FIN  SET  NO,  1),8X,I7, 
4U  sq  2A4) 

format’ (38X,16H(FIN  SET  NO.  2) ,8X .I7.4H  SQ . ,2A4) 

FORMAT  aHO,9X,39HNOTE;  IF  A  "SET"  REPRESENTS  A  PAIR  OF 
2  31HAPPENDAGES  (E.G.,  BILGE  KEELS) ,/,l7X,16HTHEN  THE  WETiED 
2  46KSURFACE  IS  COMPUTED  FOR  THE  TOTAL  AREA  OF  BOTH,/, 17/;, 

2  IIHAPPENDAGES.) 


(SET  NO.  1) ,4X, 
(SET  NO.  2) ,4X, 
1) ,12X,F7.2, 

(38X,11H(SET  NO.  2) , 12X ,F7 .2.2A4) 

U2X,37H0UTSIDE  BRACKET  MEAN  SPAN  (SET  NO.  1),12X,F7.2, 

1)  ,12X,F7.2, 

2) ,12X,F7.2, 


RETURN 

END 


C  DECK  HYD2D 

SUBROUTINE  HYD2D 


* 

♦ 

* 

* 

* 


litB  spline  to  2-d  potentials  and  forces  as  function  of  frequency 
SIGMA  is  array  of  frequencies 
PHI2D  is  array  of  2-d  velocity  potentials 
(frequency,  node,  node) 

PHELM  18  array  of  spline  segments  for  PHI2D  versus  SIGMA 

COMMON  /ENVIOR/  VK,NVK. MU, NMU, OMEGA. NOMEGA, SIGMA, HSIGMA,SIGWH, 

1  NSIGWH , TMODAL , NTMOD , NRANG , RANG , RLANG , S , NNMU , FRNUM , VFS 
INTEGER  NVK , NMU , NOMEGA , HSIGMA , NSIGWH , NTMOD , NRANG . NNMU (8 ) 

REAL  VK(8) ,MU(37,8) .0MEGA(30) ,SIGMA(10) ,SIGWH(4) ,TM0DAL(8) , 

2  RANG(8) ,RLANG(e) ,S(30,8) ,FRNUM(8) ,VFS(8) 

COMMON  /GEOM/  X,NSTATH,Y,Z,N0F5ET,LPP, BEAM, DRAFT, LCF, 

1  VCGVgM . DELGM . NEBLA , KPITCH , KROU , KY AW , KY AWRL . AWP  VCB  FBDX . FBDY , 

2  FBDZ , IFREBD , XPT , YPT , ZPT , NPTS , LCB , GML , ASTAT , BST AT .TITLE ,MAp , 

2  DISPLM , IPITCH , IRDLL , lYAW , I YAWRL . CHEAVE . CPITCH , CHEAPI , CROLL , 

2  AREAMX , WSURF .GIRTH .FBDZV .DBLWL ,TLCB 

INTEGER  NSTATN,N0FSET(25) ,NFREBD,NPTS 

^tt  A  n  *  TTTTIJ/on) 

REAl"x(2E) *Y(i6,25)”z(10,25) ,FBDZV(8,10) ,LPP ,BEAM,DBLWI.,TLCB , 

2  DRA^ . LCF  VCG; GM, D^GM , NEBLA  KPITCH . KRDLL . KYAW  KYAWRL  AWP  VCB , 

2  FBDX(io).FBDYho5.FBDZ(10),XPT(10),YPT(10),ZPT(lO),LCB,GML, 
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4  ASTAT(25) ,BSTAT(26) .MASS .DISPLM , IPITCH , IROLL , lYAW . 

6  ly AWRL , CHEAVE , CPITCH , CHEAPI . CRDLL . AREAMX , WSURF , GIRTH (25 ) 

COMMON  /INDEX/  PFIDX.LPFIDX . RMIDX .LRMIDX, SVIDX .LSVIDX 

INTEGER  LPFIDX, LRMIDX. LSVIDX 

REAL  PFIDX(235)  ,RMIDX(  183) . SVIDXO) 

COMMON  /lO/  SYSFIL.POTFIL.COFFIL.LCOFIL.ICARD.TEXFIL.IPRIN. 

2  SCRFIL . HPLFIL . LRAFIL , ORGFIL . RAOFIL . RMSFIL , SEVFIL , SPDFIL . 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL . POTFIL , COFFIL , LCOFIL , IC ARD , TEXFIL , IPRIN . 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL .SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /PELEM/  PELEM 
COMPLEX  PELEM (4, 1000) 

COMMON  /TWOD/  YY.  ZZ.  ENN.  ISTA 
INTEGER  ISTA 

REAL  YY(10.25) .ZZ(10,26) , ENN (4. 10 .25) 

COMPLEX  PHI2D(10.10,4) .PHELM(4,9,40) 

EQUIVALENCE  (PELEM( 1 . 1 ) . PHI2D (1 . 1 . 1 ) ) , ( PELEM (1.101). PHELM (1,1.1)) 

READ  (SCRFIL)  YY.ZZ. ENN, ISTA 

DO  30  K=1,HSTATN 
NPT  =  NOFSET(K) 

IF  (NPT  .LT.  2J  GO  TO  30 

*  compute  2d  potentials 

CALL  TWQDPT  (K , Y( 1 .K)  ,Z( 1 ,K) ,NPT.PHI2D) 

*  compute  spline  coeiiicients  for  PKI2D 

DO  20  L=l,4 
LH  =  (L-l)»10 
DO  10  J=1,NPT 
M  =  LM  +  J 

CALL  CPFIT  (SIGMA, PHI2D(1,J,L),PHELM(1.1,M),NSIGMA) 

10  CONTINUE 
20  CONTINUE 

*  vrite  spline  coefficients  to  potential  file 

CALL  WTPELM  (K, PHELM) 

30  CONTINUE 

RETURN 

END 

C  DECK  HYDCAL 

SUBROUTINE  HYDCAL 

COMMON  /DATINP/  OPTN.MOTN.BSCFIL.VIJICPR.RAOPR.RLDMPR.DISPLMT, 

2  LRAOPP , ADRPR , ORGDPTN , GMNOM ,KG ,STATN(26) . NSOFST (25 ) , 

2  NLEWF (25 ) , HLFBTH( 10 , 25 ) , WTRLKE( 10,26). BLEWF (25 ) , TLEWF (26 ) , 

2  AREALF(26) .NPTL0C,PTNUMB(10) ,PTNAME,XPTL0C(10) ,YPTL0C(10) , 

2  ZPTLOC(IO) ,NBB,FBNUMB(10),FBNAME,XPTFBD(10) .YPTFBD(IO), 

2  ZPTFED  ( 10  )  ,  FBCODE  ( 10  )  ,  Fi.  TYPE ,  RDOT  ( 10)  ,  VKDES .  FNDES , 

1  STATNM.STATIS 

CHARACTERe4  PTKAME(8.10) ,FBNAME(8 , 10) ,STATKM(6) ,FBTYPE(3 , 10) 
INTEGER  OPTN , MOl N . BSCFIL , VLACPR , RAOPR. ADRPR . RLDMPK , FBCODE , 

2  FBNUMB.PTNUMB.ORGOPTN 
REAL  KG 

COMMON  /lO/  SYSFIL, POTFIL, COFFIL. LCOFIL, ICARD. TEXFIL, IPRIN, 

5  SCRFIL . HPLFIL . LRAFIL .ORGFIL . RAOFIL .RMSFIL . SEVFIL . SPDFIL , 

2  sptfil;lacfil,laefil 

INTEGER  SYSFIL . POTFIL , COFFIL .LCOFIL .ICARD .TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL .RMSFIL .SEVFIL , SPDFIL , 
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2  SPTFIL.LACFIL.LAEFIL 

COMMON  /SMPSYS/  FIS , AS .SIS , SOS, SDS .HALOS, DEV ,PRN , SMPPS, SMPIS , 

2  SMPOS.SMPDS.SHPtYPS, SHIPS, VARS, CYCLS, TITLES, OPTION, LSIS.LSOS. 

2  LSDS .LHALOS ,LDEV , LPRN . LSMPPS .LSMPIS , LSMPOS , LSHPDS .LSHPTYPS , 

2  LSHIPS.LTITLES 
CHARACTER* 160  AS 

CHARACTER*80  FIS , SIS , SDS .SDS .TITLES 

CH ARACTER*20  HALOS , DEV . PRN , SMPPS , SMPIS , SMPOS . SMPDS , SHPTYPS 
CHARACTER  SHIPS*6 , VARS*2 ,CYCLS*2 
IKTEGER*2  OPTION 

CQMMON/STATE/LAT , VRT .LOADS , ADORES , SALT , HE AD , EXROLL , BKEEL 
LOGICAL  LAT , VRT . LOADS . ADORES .SALT . HEAD , EXROLL. BKEEL 

IF  (OPTN  .GT.  3)  GO  TO  10 

FIS  =  SDS(1:LSDS)//’ .SCR* 

OPEN  (UNIT=SCRFIL, FILE=FIS,FORM= ’UNFORMATTED > .STATUS^ ’UNKNOWN  - ) 
FIS  =  SDS(1:LSDS)//’ .POT’ 

OPEN  (UNIT=POTFIL, FILE=FIS,STATUS= ’UNKNOWN ’ , 

1  ACCESS= ’DIRECT ’ ,RECL=17B0) 

FIS  =  SDSCl-.LSDS)//’ .COF’ 

OPEN  (UNIT=CaFFIL.FILE=FlS .rQRM= ’UNFORMATTED ’ . STATUS= ’UNKNOWN ’ ) 

FIS  =  SDSdiLSDS)//’ .LCQ’ 

IF  (LOADS) 

2  OPEN  (UNIT=LCOFIL,FILE=FIS,FQRM=’UNFORMATTED’ ,STATUS=’UNKNOWN’ ) 

fS  =  ’  (/4X, "CALLING  HYD2D’‘)  ’ 

WRITE  (♦.AS) 

WRITE  (TEXFIL.AS) 

CALL  HYU2D 

AS  =  ' (4X. "CALLING  T3DAMD")  ’ 

WRITE  (*.AS.' 

WRITE  (TEXFIL,.AS) 

CALL  T3DAKD 

AS  =  ’(4X, "CALLING  CQFOUT")’ 

WRITS  (♦.AS) 

WRITE  (TEXFIL.AS,'' 

GALL  COF OUT 

CLOSE  (Uri;=SCRFIL) 

CLOSE  (USIT=POTFIL) 

CLOSE  (UKn=COFFlL) 

IF  (LOADS)  CLOSE  (UNIT=LCOFIL) 

10  CONTINUE 

RETURN 

END 


C  DECK  INERST 

SUBROUTINE  INERST  (OKEGAE.TV ,TL) 

COMMON  /GEOH/  X  .NSTATN  .Y  ,Z  .NOFS'ET  ,LPP  .BEAM, DRAFT, LCF, 

1  VCG ,  GW , DELGM ,  NEBLA  , KPITCH . KKOd , K.Y AW ,  KY AWRL ,  AWP  ,  VCB  ,  FBDX  .  FBD Y , 

2  FBDZ , KFR EBD , XPT , YPV , ZPT , NPTS . LCB , GML  ASTAT , BSTAT . TITLE , MASS , 

2  D (tiPLM , IPITCH , IROLL , lYAW , I YAWRL , CHEAVE . CPITCH , CHEAPI . CRDLL , 

2  AREAMX.WSURF, GIRTH, FBDZV.DBLWL.TLCB 

INTEGER  NSTATN, H0FSE-(2S) .NFREBD.NPTS 
CHARACTER^4  TITLE(20) 

REAL  X(2&:  /Y(  10 ,25)  , Z(  10 .2,^)  .FBDZ'KS ,  iO)  ,LPP  .BEAM.DBLWI  .Trr.B  , 
DRAFT , LCF , VCG , GM , DELGM .NEBLA , KPI-^CH , KROLL , KY AW , KY AWRL , AWP , VCB , 
FBDXCIO)  .FBDY(10),FBDZ(:0; ,XPT(10) ,YPT(10)  ZPT(IO) ,LCB ,GML , 
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4  ASTAT(25) ,BSTAT(25) , MASS .DISPLM , IPITCH , IROLL , lYAU , 

5  lYAWRL , CHEAVE , CPITCH .CHEAPI , CROLL, AREAMX .WSURF , GIRTH (25) 

COMMON  /STATE/  LAT, VRT, LOADS, ADORES, SALT. HE AD, EXROLL, BKEEL 
LOGICAL  LAT , VRT , LOADS . ADORES . S ALT . HEAD . EXROLL .BKEEL 

COMPLEX  TV(3,3) ,TL(3,3) 

0HGE2  =  OMEGAE+OMEGAE 
IF  (.NOT.  VRT)  GO  TO  10 

*  vertical  mode 


*  add  mass,  mass't'vcg  and  inertia  terms 


TV(1,1)  =  TV(1,1) 
TV(1.3)  =  TV(1.3) 
TV{2,2)  =  TV(2.2) 
TV(3,1)  =  TV(3,1) 
TV(3,3)  =  TV(3,3) 


0MGE2*MASS 

0MGE2*MASS*VCG 

0MGE2*MASS 

QMGE2+MASS+VCG 

0MGE2t‘IPITCH 


*  add  restoring  terms 

TV(2.2)  =  TV(2.2)  +  CHEAVE 

TV(2,3)  =  TV(2,3)  +  CHEAPI 

TV(3,2)  =  TV(3,2)  +  CHEAPI 

TV(3,3)  =  TV(3,3)  +  CPITCH 

10  IF  (.NOT.  LAT)  GO  TO  20 


*  lateral  mode 


*  add  mass,  mass+vcg  and  inertia  terms 


TL( 

u.i; 

=  TL( 

-  0HGE2*MASS 

TL( 

=  TL< 

!i.2; 

+  nMGF.2*MASS*VCG 

TL< 

;2.i: 

=  TL( 

;2.i; 

+  0HGE2*HASS*VCG 

TL( 

2.2 

=  TL( 

2,2 

-  OMGE2*IROLL 

TL( 

2,3] 

=  TL< 

!2,3] 

+  0MGE2*IYAURL 

TL( 

;3.2 

=  TL( 

;3,2; 

+  0MGE2*IYAWRL 

TL< 

!3,3] 

=  TL( 

3,3 

-  0MGE2*IYAW 

♦  add  restoring  term  to  roll 

TL(2.2)  =  TL(2,2)  +  CROLL 
20  CONTINUE 

RETURN 

END 

C  DECK  INPUT 

SUBROUTINE  INPITT 

COMMON  no/  SYSFIL.P0TFIL,C0FFIL,LC0FIL,ICARD,TEXFIL,1PRIN, 

2  SCRFIL , HPLFIL , LRAFIL .ORGFli, , RAOFIL .RKSFIL, SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL , POTFIL, COFFIL .LCOFIL .ICARD .TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL .LRAFIL .ORGFIL , RAOFIL .RKSFIL . SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /SMPSYS/  FIS,AS,SIS,SOS,SDS,HALOS.DEV,PRN,SMPPS,SMPIS 
2  SMPOS , SMPDS .SHPTYPS , SHIPS , V ARS .CYCLS .TITLES , OPTION ,LSIS , LSDS 
2  LSDS.LHALOS.LDEV.LPRN.LSMPPS.LSKPIS.LSMPOS.LSHPDS.LSHPTYPS, 

2  LSHIPS.LTITLES 
CHARACTER* 160  AS 

CHARACTER*80  FIS , SIS , SOS .SDS .TITLES 

CHARACTER*20  HALOS . DEV , PRN . SMPPS . SMPIS , SMPOS .SMPDS . SHPTYPS 
CHARACTER  SHIPS*6 ,VARS*2.CYCLS*2 
IKTEGER*2  OPTION 

AS  -  •(/4X,-'CALLI2G  PUELIK")' 

WRITE  (*,AS) 

WRITE  (TEXFIL, AS) 
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CALL  PRELIM 


FIS  =  SOS(1:LSOS)//’ .OUT’ 

□PEN  (UNIT=IPRIH ,FILE=FIS ,STATUS= 'UNKNOWN ’ ) 

AS  =  ' (4X, "CALLING  AINPUT")’ 

WRITE  (♦,AS) 

WRITE  (TEXFIL.AS) 

CALL  AINPUT 

AS  =  > (4X, "CALLING  READ")’ 

WRITE  (♦.AS) 

WRITE  (TEXFIL.AS) 

CALL  READ 

AS  =  ’(4X. "CALLING  HSTAT")’ 

WRITE  (♦.AS) 

WRITE  (TEXFIL.AS) 

CALL  HSTAT 

AS  =  ’ (4X. "CALLING  HSTOUT")’ 

WRITE  (♦.AS) 

WRITE  (TEXFIL.AS) 

CALL  HSTOUT 

RETURN 

END 

C  DECK  INTRPL 

SUBROUTINE  INTRPL  (N.XN.YN.M.XM.YM) 

♦  This  routine  obtains  a  liner  resolution  of  a  function  using 

*  linear  interpolation.  The  function  is  assumed  to  be  zero 
outside  of  the  frequency  range  of  definition. 

W.G. MEYERS.  DTNSfoc.  072877 

DIMENSION  XN(H) .YN(N) ,XM(M) .YM(M) 

KL  =  1 
KU  =  2 

DENOM  =  XN(KU)  -  XN(KL) 

SLOPE  =  0. 

IF  (DENOM  .GT.  0.)  SLOPE  =  (YN(KU)  -  YN(KL))  /  DENOM 
DO  20  1=1, M 

IF  (XM(I)  .LT.  XN(KL))  GO  TO  20 
IF  (XM(I)  .LE.  XN(KU))  GO  TO  10 
6  KL  =  KL  +  1 

IF  (KL  .EQ.  N)  GO  TO  30 
KU  =  KU  +  1 

IF  (XM(I)  .GT.  XN(KU))  GO  TO  6 
DENOM  =  XN(KU)  -  XK(KL) 

SLOPE  =  0. 

IF  (DENOM  .GT.  0.)  SLOPE  =  (YN(KU)  -  YH(KL))  /  DENOM 
10  YM(I)  =  YN(KL)  +  SLOPE  ♦  (XM(I)  -  XN(KL)) 

20  CONTINUE 
30  CONTINUE 

RETURN 

END 

C  DECK  IRGSEA 

SUBROUTINE  IRGSEA 

COMMON  /DATINP/  OPTN ,MOTN .BSCFIL.VUCPR.RAOPR.RLDMPR.DISPLMT, 
2  LRAOPR . ADRPR . ORGOPTN .GMNOM .KG .STATN (26) ,NS0FST(2B ) , 

2  NLEWF(25),HLFBTH(10.25) .WTRLNE(10.2b) ,bLEWF(2b) ,TLEWF(26) . 

2  AREALF ( 26 ) , NPTLOC , PTNUMB ( 1 0 ) , PTN AME , XPTLOC (10). YPTLOC (10), 
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2  ZPTLOC^IO) ,NBB,FBNUMB(10) ,FBNAME,XPTFBD(10) ,YPTFBD(10) , 

2  ZPTFBDUO)  .FBCODE(IO)  .FBTYPE.RDOTdO)  .VKDES  .FNDES  , 

2  STATNM.STATIS 

CHARACTERi-4  PTNAME(8,10) .FBHAHE(8 . 10) .STATNKCE) , FBTYPEC 3 , 10) 
INTEGER  OPTN,MOTN.BSCFIL,VLACPR,RAOPR,AORPR,R1.DMPR,FBCODE, 

2  FBNUMB.PTNUMB.QRGOPTN 
REAL  KG 

IF  (OPTN  .EQ.  6  .OR.  ORGOPTN  .EQ.  1)  GO  TO  10 
CALL  RKSTOE 
10  CONTINUE 

RETURN 

END 

C  DECK  LIMIT 

SUBROUTINE  LIMIT  (XLIM.YLIH .PSILIM .HEAD .FRNO .DEGRAD .FTMETR) 

*  This  routine  determines  the  limiting  values  of  surge,  sway  or  yaw 

*  regular  wave  dimensional  transfer  fuiictions  in  quartering  seas. 

*  This  is  to  prevent  blow-up  for  encounter  frequencies  near  zero. 

*  surge  arid  sway  limits  are  nondimens ional .  ihe  yaw  limit  is 

*  converted  to  deg/m  from  deg/ft  as  it  was  in  the  original 

*  source. 

*  W.G. MEYERS.  DTNSRDC.  072977 

e  VERSION  1  -  CDC  6700  -  LIMIT  -  NOVEMBER.  1973 

*  S.  BALES.  A.  E.  BAITIS.  W.  MCCREIGHT 

*  Subroutine  to  Inpoee  limit!  on  surge,  ewsy,  and  ya*  in  quartering 
and  following  seas  to  prevent  blow-up  for  near  zero  encounter 

*  frequencies.  Limits  are  selected  from  experimental  data  : 

BAITIS  -  DE-1006  destroyer, 

*  WACHVIK  A  ZARNICK  -  A/C  carrier, 

*  TASAI  -  single  screw  tanker. 

*  The  limits  should  always  be  positive  (surge)  and  may  not  be  valid 

*  for  froude  numbers  >0.4 

*  Surge  limit  is  a  function  of  heading  angle  (degrees)  and  ship 

■»  speed  (froude  number)  and  is  in  units  of  feet/feet. 

XLIM  =  .8174  +  6.946  *  FRNO  -  0.020614  ♦  HEAD 

*  Sway  limit  is  a  function  of  heading  angle  (degrees)  and  is  in 

*  units  of  faot/feet. 

YLIM  =  0.02B6  *  HEAD  +  0.3 

*  Yaw  limit  is  a  function  of  heading  angle  (degrees)  and  is  in 

*  units  of  degrees/f eet.  A  constant  wave  slope  of  one  degree 

*  is  assumed. 

IF  ((HEAD  -40.)  .LE.  0.006)  PSILIM  =  0.0206  ♦  HEAD  +  0.276 
IF  ((HEAD  -40.)  .GT.  0.006)  PSILIM  =  1.876  -  0.0193  *  HEAD 

*  Yaw  limit  is  converted  to  units  of  radians  /  meter 

PSILIM  =  PSILIM  *  DEGRAD  /  FTMETR 

RETURN 

END 

C  DECK  LRAO 

SUBROUTINE  LRAO  (IM.HL,NU,M0TV,SF3,SH3,SA33,SB33,V,C0SMU, 

2  OMEGA , OMEGAE , IP , RAO , PHS . NHOT , NOMEGA, IPHS) 

COMMON  /DATIHP/  OPTN ,M0TN .BSCFIL, VLACPR.RAOPR.RLDMPR.DISPLMT , 

2  LRAOPR . ADRPR , ORGOPTN , GMNOM , KG , STATH ( 26 ) , NSQFST ( 26 ) , 

2  KLEWF(26),KLFBTH(10,2E)  .yT-RLSEdO ,26^  .BI.F.UFf2E)  .TLEUF(25)  . 
2AREALF(26),NPTL0C,PTNUMB(10),PTNAME, XPTLOC (10),YPTL0C(10), 
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CN  CN  (N 


ZPTLOC(;iO)  .NBB.FBNUMBdO)  .FBNAHE  ,XPTFBD{  10 )  ,YPTFBD(10)  , 
ZPTFBDUO)  .FBCODEdO)  , FBTYPE.RDOTdO)  , VKDES , FNDES , 

STATNM.STATIS 

CHARACTER*4  PTNAME(8,10) .FBNAHEIB, 10) ,STATNM{5) ,FBTYPE(3 , 10) 
INTEGER  OPTN , MOTN , BSCFIL . VLACPR , RAOPR , ADRPR , RLDMPR , FBCODE , 
FBHUMB.PTNUMB.ORGOPTN 
REAL  KG 

COMMON  /GEOM/  X , NSTATN ,Y .Z .NOFSET ,LPP . BEAM .DRAFT ,LCF . 

VCG  ,  GM  , DELGM  ,  NEBLA , KPITCH  ,  KROLL ,  KY AW ,  K Y  AVIRL  ,  AWP  ,  VCB  ,  FBDX  ,  FBDY  , 
FBDZ , NFREBD , XPT . YPT . ZPT , NPTS , LCB . GML . ASTAT , BSTAT , TITLE , MASS , 
DISPLM , IP ITCH , IROLL , lY AW , I Y AWRL , CHEAVE , CP ITCH , CHEAP I , CRQLL , 
AREAMX , WSURF , GIRTH , FBDZV . DELWL , TLCB 
INTEGER  NSTATN .NQFSET(26) .NFREBD, NPTS 
CHARACTER*4  T1TI,E(20) 

REAL  X(25) .YClO. 25) .2(10,25) ,FBDZV(8 . 10) ,LPP .BEAM .DBLWL , TLCB , 

2  DRAFT , LCF , VCG , GM , DELGM .NEBLA , KPITCH . KROLL, K YAW , KY AWRL . AWP . VCB , 

2  FBDXdO),FBDYdO)  .FBDZdO)  . XPTdO)  .YPTdO)  , ZPTClO) . LCB . GML . 

4  ASTAT(25) ,BSTAT(2E) .MASS .DISPLM . IPITCH , IROLL . lYAW . 

5  I YAWRL , CHEAVE , CPITCH . CHE API . CROLL , AREAMX , WSURF . GIRTH ( 25 ) 

COMMON  /LOADS/  NLOADS ,SWGHT(25) . SMASS(25) .XLDSTNClO) ,XLDXPT(25) , 
2  LSTATN(25) 

COMMON  /PHYSCO/  II .TPI .PI , PIOT. DEGRAD .RADDEG .VKMETR.METRVK.GRAV . 
2  RHO , GNU , RHQS . RHOF , GNUS . GNUF .FTMETR.PUNITS , REYSCL 
COMPLEX  II 

CHARACTER*4  PUNITS(2) 

REAL  TP I . PI . PIOT . DEGRAD , RADDEG . VKMETR , METRVK , GRAV . RHO . GNU . RHQS , 

1  RHOF, GNUS, GNUF, FTMETR 

COMPLEX  MOTV (NMOT , NOMEGA ) , IWE ,VIWE .HEAVE . HEAVEL . HEAACC .PITCH . 

2  PITVEL . PITACC . VERVEL , VERACC .ZERO . INERT . RESTOR, EXCIT . CEP , 

2  HYDRO . LOAD , SF3 ( 25 , NOMEGA ) , SH3(2S . NOMEGA ) 

COMPLEX  STEMP ( 25 ) , ELEHS (4 . 26 ) , EXF , SAB33 ( 25 ) , CDUM . HYD . CSUM 
DIMENSION  RAO(NOMEGA) .PHS(NOMEGA) ,OMEGA(NOMEGA) ,DMEGAE(NOKEGA) 
DIMENSION  SA33(25, NOMEGA) ,SB33(2S, NOMEGA) 

CHARACTER*4  METER 

DATA  METER  /‘METE’/ 

ZERO  =  (0. ,0.) 

XP  =  XLDXPT(IP) 

KSTATN  =  LSTATN(IP)  -  1 
NPS  =  NSTATN  -  KSTATN  +  1 
V2  =  V*V 
CON  =  1000 

IF  (PUNITSd)  .HE.  METER)  COB  =  2240 

RHOG  =  RHO+GRAV 

DO  100  I=NL,NU 

W  =  OMEGA (I 5 

WN  =  W*W/GRAV 

TEST  =  .005*TPI/LPP 

ARGLI  =  -  WNfCOSMU 

IF  (ABS(ARGLI)  .LE.  TEST)  ARGLI  =  0. 

WE  =  OHEGAE(I) 

WE2  =  WE*WE 
IWE  =  IlfWE 
VIWE  =  V/IWE 
VWE2  =  V/WE2 
V2WE2  =  V2/WE2 
HEAVE  =  MOTV (2. I) 

HEAVEL  =  IWE*HEAVE 
HEAACC  =  IWE*HEAVEL 
PITCH  =  M0TV(3,I) 

PITVEL  =  IWEfPITCH 
PITACC  =  IWE*PITVEL 
VERVEL  =  HEAVEL  -  XP*PITVEL 
VERACC  =  HEAACC  -  XP*PITACC 


♦  inertin  term 
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INERT  =  ZERO 
Ml  =  KSTATN  +  1 
DO  10  K=M1,NSTATN 

STEMP(K)  =  SMASS(K)*(HEAACC  -  X{K)*PITACC) 

IF  (IM  .EQ.  13)  STEMP(K)  =  -  (X(K)-XP)*STEHP(K) 
INERT  =  INERT  +  STEMP(K) 

10  CONTINUE 


restoring  term 

DO  20  K=KSiATN,NSTATN 
NPT  =  HOFSET(K) 

S3EAM  =  2*Y(NPT.K) 

STEMP(K)  =  SBEAM*(HEAVE  -  X(K)*PITCH) 

IF  CIM  .EQ.  11)  STEHPCK)  =  -  STEMP(K) 

IF  CIM  .EQ.  13)  STEMP(K)  =  (X(K)-XP)*STEMPCK) 

20  CONTINUE 

CALL  CPFIT  (X(KSTATN) .STEMP(KSTATN).ELEMS,NPS) 

CALL  CPINTG  (XP , XCNSTATN ) , XCKSTATN ) ,NPS .ELEHS, 0 . .RESTOR) 

RESTOR  =  RHaG*RESTOR 

♦  exciting  term 

DO  30  K=KSTATN .NSTATN 
STEMP(K)  =  SF3(K.I)  +  SH3(K,I) 

IF  (IM  .EQ.  13)  STEMP(K)  =  -  ( (X(K)-XP)*STEMP(K)  + 

2  VIWE*SH3(K.I)) 

30  CONTINUE 

CALL  CPFIT  (X(KSTATN) .STEMP(KSTATN).ELEMS.NPS) 

CALL  CPINTG  (XP .XCNSTATN) .XCKSTATN) , NFS. ELEH6, ARGLl , SXCIT) 

IP  (.NOT.  IM.EQ!in  00  t6  S6 

CALL  CPFIT  (X(KSTATN),SH3(KSTATN.I).ELEMS.NPS) 

CALL  CPLVAL  (X (KSTATN) ,NPS . ELEMS , XP .EXF.CDUH . lELM) 

CEP  =  CEXP(:i*XP*ARGLl) 

EXCIT  =  EXCIT  +  VIWE*CEP«EXF 
35  EXCIT  =  RHO+EXCIT 

*  hydrodynamic  terra 

DO  40  K=KSTATN, KSTATN 
A33  =  SA33(K.I) 

B33  =  SB33(K.l) 

SAB33(K)  =  A33  +  II+B33 

IF  (IM  .EQ.  11)  STEMP(K)  =  -  (A33*(HEAACC-X(K)*PITACC)  + 

2  B33*(HEAVEL-X(K)*PITVEL)  -  VWE2*B33*PITACC  +  V*A33*PITVEL) 

IF  (IM  .EQ.  13)  STEMP(K)  =  (X(K)-XP)f(A33*(HEAACC-X(K)*FITACC) 
2  +  B33*(HEAVEL-X(K)*PITVEL))  +  (V*A33*VERVEL  VWE2*B33*VERACC 
2  -  V2WE2*(A33*PITACC  +  B33+PITVEL)) 

40  CONTINUE 

CALL  CPFIT  (X(KSTATN),STEMP(KSTATN). ELEMS. NPS) 

CALL  CPINTG  (XP,X(SSTATK) .X(KSTATH) .KPS, ELEMS, 0. .HYDRO) 

IF  (.NOT.  IM.EQ.ll)  GO  TO  45 

CALL  CPFIT  (X(KSTATN),SAB33(KSTATN) .ELEMS, NPS) 

CALL  CPLVAL  (X(KSTATN) , NPS, ELEMS. XP.UYD.CDUM.IELM) 

A33  =  REAL(HYD) 

B33  =  AIMAG(HYD) 

HYDRO  =  HYDRO  -  (V+ASSt-VERVEL  -  VWE2*B33*VERACC  - 
2  V2WE2*(A33*PITACC  +  B33+PITVEL)) 

46  CONTINUE 

CSUM  =  RESTOR  +  EXCIT  +  HYDRO 
LOAD  =  INERT  -  CSUM 
LOAD  =  LOAD/COK 

CALL  RAOPKA  (LOAD,RAO(I) ,PHS(I) .RADDEG.IPHS) 

100  CONTINUE 

RETURN 

END 

C  DECK  LRAOUT 

SUBROUTINE  LRAOUT 

COMMON  /DATINP/  OPTN.MOTK .BSCFIL.VIACPR.RADPR.RLDMPR.DISPLMT, 
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to  KJ  lO  >-»  to  >-»  to  M  to  to  to  W  W 


LRA0PR,ADRPR,0RG0PTN,GKN0H,KG,STATN(25)  ,NS0FST(25) , 

KLEWF(26) ,HLFBTH(10,26) ,WTRLNE( 10 ,25) , BLEWFC25 ) ,TLEWF(25) , 
AREALF(26) .NPTLOC .PTNUHB(IO) ,PTNAME,XPTLDC(10) .YPTLOCUO) , 
ZPTLOC(10),NBB,FBNUMB(10),FBNAME.XPTFBD(10) .YPTFBD(IO), 

ZPTFBD ( 10 ) . FBCODE ( 10 ) . FBTYPE , ROOT ( 10 ) , VKDES . FNDES , 

STATNM  STATIS 

CHARACTER+4  PTNAME(8,10) ,FBNAME(8 , 10) , STATMM(E ) , FBTYFEC 3 , 10) 
INTEGER  OPTN , MOTH , BSCFIL , VLACPR , RAQPR , ADRPR , RLDMPR , FBCODE , 

FBNUMB , PTNUMB , QRGQPTN 
REAL  KG 

COMMON  /ENVIOR/  VK .NVK, MU, HHU. OMEGA, NOMEGA , SIGMA .NSIGMA .SIGWH, 
NSIGWH , TMODAL , NTMOD , NRANG , RANG . RLANG , S , NNMU ,FRNUH , VFS 
INTEGER  NVK , NMU , NOMEGA , KSIGMA .NSIGWH . NTHOD .NRANG , HNHU (8 ) 

REAL  VK(8) .MU(37.8) .0MEGA(30) .SIGMA( 10) ,SIGWH(4) ,TM0DAL(8) , 
RANG(8) ,RLANG(8) ,S(30,8) ,FRNUM(8) ,VFS(8) 

COMMON  /GEOM/  X , NSTATN ,Y ,2 , NOFSET ,LPP .BEAM .DRAFT , LCF , 

VCG , GM . DELGM , NEBLA . KPITCH .KROLL ,KYAW , KYAWRL , AWP , VCB , FBDX , FBDY , 
FBDZ , NFREBD , XPT , YPT , 2PT , NPTS , LCB . GML , ASTAT . BSTAT , TITLE , HASS , 
DISPLM,IPITCH,IRQLL,IYAW.IYAWRL,CHEAVE,CPITCH,CHEAPI,CROLL, 
AREAMX.WSURF, GIRTH, FBDZV.DBLWL.TLCB 
INTEGER  NSTATN .N0FSET(25) .NFREBD, NPTS 
CHARACTER+4  TITLE(20) 

REAL  X(25),Y(10.2E),Z( 10,25) .FBD2V(8 . 10) ,LPP .BEAM .DBLWL . TLCB , 

2  DRAFT , LCF . VCG , GM, DELGM .NEBLA , KPITCH . KROLL , KY AW , KYAWRL . AWP , VCB . 

2  FBDX(IO) ,FBDY(10) .FBDZ(IO) ,XPT(10) ,YPT(10) ,ZPT(10) .LCB, GML, 

4  ASTAT(2S) ,BSTAT(25) .MASS .DISPLM , IPITCH , IROLL , lYAW , 

5  I YAWRL . CHEAVE . CPITCH . CHEAP I , CROLL , AREAMX , WSURF , GIRTH ( 25 ) 

COMMON  /IQ/  SYSFIL.PQTFIL.COFFIL.LCOFIL.ICARD.TEXFIL.IPRIN, 

2  SCRFIL.HPLFIL.LRAFIL.QRGFIL.RAQFIL.RMSFIL.SEVFIL.SPDFIL, 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL , POTFIL . COFFIL , LCOFIL . ICARD , TEXFIL . IPRIN , 

2  SCRFIL , HPLFIL . LRAFIL , ORGFIL . RAOFIL . RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /LOADS/  NLOADS ,SWGHT(25) ,SMASS(26) ,XLDSTN(10) .XLDXPT(2S) , 
2  LSTATN(26) 

COMMON  /PHYSCO/  II ,TPI , PI ,PIOT, DEGRAD .RADDEG .VKHETR.METRVK ,GRAV , 
2  RHO . GNU , RHOS , RHOF , GNUS , GNUF , FTMETR , PUN ITS , REYSCL 
COMPLEX  II 

CHARACTER*4  PUNITS(2) 

REAL  TPI . PI , PIDT , DEGRAD , RADDEG . VKHETR.METRVK , GRAV , RHO , GNU , RHOS , 

1  RHOF, GNUS. GNUF. FTMETR 

COMMON  /SMPSYS/  FIS, AS, SIS, SOS, SDS, HALOS, DEV, PRN.SMPPS.SMPIS, 

2  SHPOS , SMPDS , SHPTYPS .SHIPS , VARS , CYCLS .TITLES , OPTION , LSIS . LSOS , 

2  LSDS , LHALCS , LDEV , LPRN , LSMPPS , LSMPIS , LSMPOS .LSMPDS , LSHPTYPS , 

2  LSHIPS.LTITLES 
CHARACTER* 160  AS 

CHARACTER*80  FIS .SIS . SOS , SDS .TITLES 

CEARACTER*20  HALOS . DEV . PRN . SMPPS . SMPIS , SMPOS , SMPDS , SHPTYPS 
CHARACTER  SHIPS*6,VARS*2.CYCLS*2 
IMTEGER*2  OPTION 

COMMON  /STATE/  LAT.VRT, LOADS, ADDRES, SALT, HEAD, EXROLL, BKEEL 
LOGICAL  LAT , VRT , LOADS , ADDRES , SALT .HEAD , EXROLL , BKEEL 

COMPLEX  HOTV(3.30),MOTL(3,30,8),HJV(3,30),HJL(3,30) ,H7(30) , 

2  SF3(25,30),SH3(26.30) 

DIMENSION  SA33(26,30),SB33(26,3O),OMEGAE(30),VSFRA0(30) , 

2  VSFPHS(30) ,VBMRA0C30) ,VBMPHS(30) 

CHARACTER+4  METER 
CHARACTER*2  UNITS 

DATA  METER  /’METE’/ 

IF  (PUHITSd)  .EQ.  KETER)  UNITS  =  ’  M’ 

IF  (PUNITS(l)  .HE.  METER)  UNITS  =  'FT' 
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ooo 


FIS  =  SDS(1:LSDS)//’.0RG* 

OPEN  (UNIT=ORGFIL,FILE=FIS  ,FQRM=  'UNFORMATTED  STATUS---  'UNKNOWN  ’ ) 
FIS  =  SDS(1:LSDS)//' .1X0' 

OPEN  (UNIT-LCOFIL,FILE=FIS,FORM= 'UNFORMATTED' .STATUS- 'UNKNOWN ’ ) 
FIS  =  SDS(l:LSDS)//'.LRA’ 

OPEN  (UNIT=LRAF1L,FILE=FIS,F0RM=*UNF0RMAT7ED’ .STATUSr.'UNKNOWN' ) 

READ  (ORGFIL)  TITLE ,NVK ,NMU .NQMEGA .OMEGA .NRANG .RLANG ,VRT ,LAT , 

2  ADDRES . LPP . BEAM . DRAFT . DISPLM . GM , DELGM . KG , KROLL . LCB . GR AV , RHO . 

2  VKDES.VKINC.DBLWL 

WRITE  (LRAFIL)  TITLE . NOMEG A . OMEGA . NVK , NMU . LPP . BEAM . DRAFT , DISPLM . 

2  GM . DELGM .KG . KROLL . LCB . DBLWL , GRAV . KSTATN .STATN , NLOADS . SWGHT . SMASS . 
2  XLDSTN.XLDXPT.X 


10 


2 

2 

1000 

2 

2 

2 

2 

C 

C1030 
C  2 

1010 

2 

2 


1020 

20 

2100 

* 

2 


2110^ 

2120*' 


2130 


DO  300  IV=1.NVK 
DO  200  IH=1.NMU 

READ  (ORGFIL)  VKNOTS .HEADNG .OMEGAE 
IF  (VRT)  READ  (ORGFIL)  MCTV 
IF  (LAT)  READ  (ORGFIL)  MOTL 
IF  (ADDRES)  READ  (ORGFIL)  HJV.HJL.H7 
HDNG  =  180.  -  HEADNG 
COSMU  =  COS(MU(IH.IV)) 

DO  10  IW=1.N0MEGA 

READ  (LCOFIL)  (SF3(I . IW) .SH3(I ,IW) .SA33(I . IW) ,SB33(I . IW) . 
I=1.NSTATN) 

CONTINUE 

DO  100  IP=1. NLOADS 

IH  =  11  ,  ^ 

CALL  LRAO  (IM, 1 .N0MEGA.M0TV.SF3.SH3.SA33.SB33.VFS(IV) , COSMU. 

OMEGA . OMEGAE , IP , VSFRAO , VSFPHS , 3 , NOMEGA , 1 ) 

IM  =  13  ,  ^ 

CALL  LRAO  (IM.l .NOMEGA. MnTV,SF3,SH3,SA33.SB33,VFS(IV) .COSMU, 

OMEGA . OMEGAE , IP . VBHRAO . VBMPHS . 3 .NOMEGA , 1 ) 

WRITE  (IPRIN.IOOO)  TITLE. XLDSTN(IP) , VKNOTS, HDNG 
FORMAT  (1H1./.28X.20A4.///,43X. 

33HL0AD  RESPONSE  AMPLITUDE  OPERATORS  ,  , 

18H  (RAOS)  AND  PHASES ,/// ,60X ,7HSTATI0N .FB . 1 .///, B6X . 

12HSHIP  SPEED  =,FB.0,6H  KNOTS ./ ,S3X, 14HSHIP  HEADING  ", 

FB.0.8H  DEGREES) 

WRITE  (IPRIN.1030)  TMODAL(KS) .STATIS. (STATNM(I) ,1=1 .3) 

FORMAT  (/64X'M0DAL  PERIOD  ='F4.0’  SECONDS '/B4X' STATISTIC  =’FS.2, 

’  (’3A4')'//) 

WRITE  (IPRIN,1010)  UNITS 

FORMAT  (//,20X,11HV.SHEAR(V3) ,9X,10HV.M0M. (VB) ,/,2X. 

12H0MEGA  OMEGAE, 4X,2(1BHAMPL.  PHASE, 4X) ,/,4X,3HRPS,4X,3HRPS, 
4X , 6H  TONS , 6X , 3HDEG , 4X , A2 , 6H-T0NS , 8X , 3HDEG , / ) 

DO  20  IW=1. NOMEGA  ,  ,  ,  , 

WRITE  (■IPRTN.1020)  OMEGA(IW) ,OMEGAE(IW) .VSFRAO(IW) .VSFPHS(IW) , 
VBMRAO(iw) , VBMPHS (IW) 

FORMAT  ( 2F7 . 3 , 2( 1PE12 . 4 , 0PF7 . 1 ) ) 

CONTINUE 

WRITE  (IPRIK,2100) 

FORMAT  (//2X'N0TES;  l)  VERTICAL  RAOS  ARE  ’  ^ 

'LINEAR  AND  INDEPENDANT  OF  SEA  STATE.’/  9X’2)  LATERAL  RAOS  ’ 

•ARE  NONLINEAR  AND  CHANGE  WITH  SEA  STATE  AND  ' 

'STATISTIC. ’) 

IF  (PUNITSU)  .EQ.  METER)  WRITE  (IPRIN,2110) 

IF  (PUHITS(l)  .NE  METER)  WRITE  (IPRIH,2120) 

FORMAT  (9X’3)  AMPL.  IS  IN  (PHYS.UHITS/METER) ’ ,2H**, '2  AND  PHASE  ' 
'IS  IN  DEGREES. ’ ) 

FORMAT  (9X’3)  AMPL.  IS  IN  (PHYS .UNITS/FOOT) ' .2H** , ’ 2  AND  PHASE  ’ 
'IS  IN  DEGREES. ’) 

WRITE  (IPRIK  2130) 

FORMAT  (9X’45  HEADING  CONVENTION:  0  DEG=HEAD,  90  DEG=STBD  BEAM,  ‘ 
'180  DEG=FOLLOWING  SEAS.’) 

WRITE  (IPRIN.1030) 

v'nr.u^T  ///  •^V  yiccunTP.  nrnnnid  rnvvPBTTnw  •  G  nF.GsHEAD .  90  DF.G=. 
36H  STBD  BEAM,  180  DEG=  FOLLOWING  SEAS.) 

WRITE  (LRAFIlJ  XLDSTN(IP), VKNOTS, HONG. OMEGAE, VSFRAO, VSFPHS, 


89 


2  VBMRAO.VBHPHS 
100  CONTINUE 
200  CONTINUE 
300  CONTINUE 

CLOSE  (UNIT=0RGFIL) 

CLOSE  (UNIT=LC0FIL) 

CLOSE  (UN1T=LRAFIL) 

RETURN 

END 

C  DECK  LSCOF 

SUBROUTINE  LSCOF  (OHEGA.OMEGAE.IAPAM, SPAN, HCHORD, AREA. LCS, 

2  GAMMA , XCP , TCP , ZCP , TLG , EXCLG , TLGC . EXCLGC ) 

COMMON  /CH3D/  ISIGMA .SIGMIN .SIGMAX ,V .SINMU, COSMU ,WTSI , 

2  IMMIN.IMHAX.IMDEL.LMIN ,LHAX 

REAL  SIGMIN, SIGMAX, V. SINMU, COSMU, WTSI (4) 

INTEGER  ISIGMA . IMKIN , IMMAX , IMDEL.LMIN .LMAX 

COMMON  /GEOM/  X , NSTATN . Y ,Z , NOFSET ,LPP .BEAM .DRAFT , LCF , 

1  VCG.GM.DELGM.NEBLA .KPITCH ,KROLL ,KYAW .KYAWRL , AWP , VCB , FflDX ,FBDY , 

2  FBDZ,NFREDD,XPT.YPT,2PT,NPTS.LCB,GML,ASTAT,BSTAT. TITLE, HASS, 

2  DISPLM , IPITCH , IROLL , lYAW . I YAWRL , CHEAVE, CPITCH , CHEAPI . CROLL , 

2  AREAMX.WSURF, GIRTH, FEDZV.DBLWL.TLCB 

INTEGER  NSTATN ,N0FSET(25) , NFREBD.NPTS 
CHARACTER*4  TITLE(20) 

REAL  X(25) .Y(10.26) ,Z(10,26) ,FBD2V(8 , 10) ,LPP .BEAM .DBLWL ,TLCB , 

2  DRAFT, LCF, VCG.GM.DELGM.NEBLA, KPITCH, KRQLL.KYAW'.KYAURL, AWP, VCB, 

2  FBDX(IO) .FBDYdO) ,FBDZ(10) .XPT(IO) ,YPT(10) ,ZPT(10) .LCB.GML, 

4  ASTAT(2S ) ,BSTAT(26 ) .MASS .DISPLM .IPITCH . IROLL , lYAW , 

6  I YAWRL , CHEAVE , CPITCH .CHEAPI . CROLL . AREAMX , WSURF , GIRTH ( 25 ) 

COMMON  /HULL/  A26 

COMMON  /PHYSCO/  II ,TPI , PI , PIOT .DEGRAD .RADDEG , VKMETR , METRVK , GRAV , 
2  RHO , GNU , RHOS , RHOF , GNUS , GNUF , FTMETR .PUNITS , REYSCL 
COMPLEX  II 

CHARACTER*4  PUNITS (2) 

REAL  TP I , PI . PIOT , DEGRAD . RADDEG . VKMETR , METRVK , GRAV , RHO , GNU , RHOS , 

1  RHOF, GNUS. GNUF. FTMETR 

COMPLEX  TLG ( 3 , 3 ) , EXCLG ( 3 ) , TLGC ( 3 , 3 ) . EXCLGC ( 3 ) , F2 , DF2 , DF4 , DF6 
COMPLEX  TF(3,3) 

COMPLEX  VIW.ZERO.CTEMP 
REAL  MCEORD.LCS 
REAL  I44G 
LOGICAL  HULL 

EXTERNAL  EXP 

0MGE2  =  0MEGAE*0MEGAE 
ZERO  =  (0. ,0. ) 

VIW  =  V/(II+0MEGAE) 

V2W2  =  (V/0MEGAE)*»2 
CK  =  OMEGA^OMEGA/GRAV 
SINGAM  =  SIH(GAHMA*DEGRAD) 

COSGAM  s  COStGAMMA^DEGRAD) 

S1N2GM  =  SINGAK*SINGAM 

ARG  =  -  CK*(XCP»COSHU  +  YCP*SINMU) 

FZ  =  (RH0/2)*AkEA*V«LCS 
YHAT  =  YCP*COSGAM  +  ZCP^SIKGAM 
A?  =  0 

IF  (lAPAM  .HE.  1)  GO  TO  5 

*  added-masB  dua  to  bilgekeel 

I44G  =  MASS*(KR0LL*BEAM)**2 
CB  =  NEBLA/(LPP*BEAM+DRAFr) 

DA44BK  =  (.184  -  .365*CB  +  .2»y*CB*i;b)'»i44u/4 
AP  =  DA44BK/(YHAT*YHAT) 


GO  TO  e 

6  IF  (lAPAM  .Eq.  0)  GO  TO  8 

*  rudder  or  lin  added-mass 

AP  =  PI*RH0*SPAN*(MCH0RD/2)**2 
8  CONTINUE 

HULL  =  .FALSE. 

IF  (MCHORD  .EQ.  LPP)  HULL  =  .TRUE. 

IF  (.NOT.  HULL)  GO  TO  52 

hull 

DF2  =  ZERO 
DF4  =  ZERO 
DF6  -  ZERO 
SP  =  0 

DO  42  L=1.NSTATN 

IF  (L  .EQ.  1)  DX  =  (X(2)  -  X(l))/2 

IF  (L  .EQ.  NSTATN)  DX  =  (X(NSTATH)  -  X(NSTATN-1 ) )/2 
IF  (L.GT.l  .AND.  L.LT. NSTATN)  DX  =  (X(L+1)  -  X(L-l))/2 
DX  =  ABS(DX) 

KPT  =  NOFSET(L) 

IF  (NPT  .LT.  2)  GO  TO  42 
T  =  ABS(Z(1,L)) 

Z2  =  Z(l,L)/2 
A  =  T*DX 
SP  =  SP  +  A 

F2  =  FZ+OHEGA*(SIHGAM*SINMU  -  I1*C0SGAH)* 

2  CEXP(CK*(Z2  -  II*X(L)*COSMU)) 

CTEHP  =  F2*SINGAM*A 
DF2  =  DF2  +  CTEHP 

DF6  =  DF6  +  X(L)*CTEMP  +  VIW*CTEMP 
42  CONTINUE 

DF2  =  DF2/SP 
DFC  =  DF6/Sr 

CB  e  NEBLA/(LPP*BEAM*DRArr) 

CX  =  AREAMX/(BEAM*DRAFT) 

CP  =  CB/CX 
GO  TO  62 
52  CONTINUE 

F2  =  (FZ  +  II*0MEGA£*AP)*0MEGA*(SIHGAM*SI»MU  -  II*COSGAM) 
2  *EXP(CK+2CP)*(C0S(ARG)  +  II*SIN(ARG)) 

DF2  =  F2*SINGAM  “ 

DF4  =  -  F2*YHAT 
DFC  =  XCP*DF2 
62  CONTINUE 

DA22  =  AP*SIH2GM 

DB22  =  FZ*SIN2GM 

DA24  =  -  APfYHAT*SlNGAM 

DB24  =  -  FZ*YHAT*SINGAK 

DA2G  =  XCP»DA22 

DB26  =  XCP*DB22  -  V*DA22 

DC26  =  -  V*DB22 

DA42  =  DA24 

DB42  =  DB24 

DA44  =  AP*YHAT*YHAT 

DB44  =  FZeYHATeYHAT 

DA46  =  XCP*DA24 

DB46  =  XCP*DB24  -  V*DA24 

DC46  *  -  V*DB24 

DA62  =  DA26 

DB62  =  XCP*DB22  +  V*DA22 
DC62  =  V*DB22 
DA64  =  DA46 

DB64  =  XCP*DB24  +  V*DA24 

DCe4  =  V*DB24 

DA66  =  XCP*XCP*DA22 

IF  (.NOT.  HULL)  DB66  =  XCP*XCP*DB22  +  V2VI2*DB22 
IF  (HULL)  DB66  =  (CP*LPP/2) **2  *  DB22  +  V*A26  V2W2*DB22 

DC66  =  -  V*V*Da22 

TF(1,1)  =  -  0MGE2+DA22  +  II*DMEGAE'*DB22 
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TF(1,2)  =  -  0MGE2*DA24  +  II*0MEGAE*DB24 
TF(1,3)  =  -  0KGE2*DA26  +  DC26  +  II*0MEGAE*DB26 
TF(2.1)  =  TF(1,2) 

TF(2,2)  =  -  0MGE2+DA44  +  1I*0MEGAE*DB44 
TF(2,3)  =  -  0MGE2+DA46  +  DC46  +  II*0MEGAE*DB46 
TF(3,1)  =  -  0MGE2*DA26  +  DC62  +  II*0MEGAE*DB62 
TF(3,2)  =  -  0MGE2*DA46  +  DC64  +  II+0MEGAE*DB64 

TF(3,3)  =  -  0MaE2*DA66  +  DC66  +  I1*0MEGAE+DB66 

DO  20  1=1,3 
DO  10  .1=1,3 

TLGC(I,J)  =  TLG(I,J)  +  TF(I,J) 

10  CONTINUE 
20  CONTINUE 

EXCLGC(l)  =  EXCLG(l)  +  DF2 

EXCLGC(2)  =  EXCLG(2)  +  DF4 

IF  (.NOT.  HULL)  EXCLGC(3)  =  EXCLG(3)  +  DF6  +  VIWtDF2 
IF  (HULL)  EXCLGC(3)  =  EXCLG(3)  +  DF6 

RETURN 

END 

C  DECK  NORMAL 

SUBROUTINE  NORMAL  (PSEGS) 

COMMON  /GEOM/  X ,NSTATN , Y ,Z ,NOFSET ,LPP , BEAM , DRAFT ,LCF , 

1  VCG , GH ,DELGM ,NEBLA ,KPITCH .KROLL ,KYAW .KYAWRL , AWP , VCB , FBUX ,FBDy , 

2  FBDZ , NFREBD , XPT , YPT . ZPT , NPTS , LCB , GML , ASTAT , BST AT , TITLE , MASS , 

2  DISPLM , IPITCH , IROLL . lYAW , lYAWRL , CHEAVE, CPITCH , CHEAPl , CROLL , 

2  AREAMX , WSURF , GIRTH , FBD2V .DBLWL ,TLCB 

INTEGER  NSTATN,N0FSET(26), NFREBD, NPTS 
CHARACTER*4  TITLE(20) 

REAL  X(26) ,Y(10.26) ,2(10,26) ,FBDZV(8, 10) , LPP, BEAM, DBLWL, TLCB, 

2  DRAFT , LCF , VCG , GM , DELGM , NEBLA , KPITCH , KROLL, KYAW .KYAWRL , AWP , VCB , 
2  FBDX(10),FBDY(10) ,FBDZ(10) ,XPT(10) .YPTClO) ,2PT(10) ,LCB,GML, 

4  ASTAT(2S) ,BSTAT(25) , MASS, DISPLM, IPITCH. IROLL, lYAW, 

6  lYAWRL , CHEAVE , CPITCH , CHEAPl , CROLL , AREAMX , WSURF , GIRTH ( 25 ) 

COMMON  /WGHTS/  WTDL,KORM 
REAL  WTDL(10,26),KORM(4,10,25) 

DIMENSION  PSEGS(8,9,25) 

DIMENSION  V(2),  P(2) .  PT(2),  PM(2,6),  SEGS(8,4),  ND1(2), 

2  ENDI(2,2) 

DATA  IDI,  ENDI  /  2'*1.  4*0, 0  / 

calculate  2d  normals  (n2,  n3,  n4)  at  nodes 

DO  100  K=1,NSTATN 
HP  =  NOFSET(K) 

IF  (HP  .LT.  2)  GO  TO  100 
DO  60  J=1,HP 
IF  (J  .EQ.  HP)  GO  TO  20 
CY  =  PSEGS(3,J,K) 

CZ  =  PSEGS(4,J,K) 

GO  TO  30 
20  CONTINUE 

JJ  =  J  -  1 
CY  =  PSEGS(7,JJ,K) 

CZ  =  PSEGS(8,JJ,K) 

30  CONTINUE 

DEN  =  SORT  (Cy*CY  +  CZ*CZ) 

IF  (DEN  .GT.  0.0)  GO  TO  40 
I0RM(2,J,K)  =  0.0 
H0RM(3,J,K)  =  0.0 
GO  TO  45 
40  CONTINUE 

H0RM(2.J,K)  =  -CZ  /  DEN 
NDRM(3,J,K)  =  CY  /  DEN 
45  CONTINUE 

V0RM(4.J.K)  =  Y(J.K)*N0RM(3,J,K)  -  Z(J,K)*NDRM(2, J,K) 

60  CONTINUE 
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100  CONTINUE 

*  calculate  longitudinal  normals  (nl)  at  nodes 

DO  600  K=1,NSTATN 
NP  =  NOFSET(K) 

IF  (NP  .LT,  2)  GO  TO  600 
NSEGS  =  NP  -  1 
IB  =  K  -  2 

IF  (IB  .GT.  1)  GO  TO  160 
IB  =  1 

IF  (NOFSET(l)  .LT.  2)  IB  =  2 
150  CONTINUE 

IE  =  IB  +  4 

IF  (IE  .LT.  NSTATN)  GO  TO  200 
IE  =  NSTATN 

IF  (NOFSET(NSTATN)  .LT.  2)  IE  =  NSTATN  -  1 
IB  =  IE  -  4 
200  CONTINUE 

DO  400  J=1,NP 
II  =  0 

P(l)  =  Y(J.K) 

P(2)  =  Z(J,K) 

V(l)  =  NORMO.J.K) 

V(2)  =  -NQRM(2.J,K) 

DO  300  I=IB,IE 

IF  (I  .NE.  K)  GO  TO  220 

II  =  II  +  1 

IK  =  II 

PT(1)  =  P(l) 

PT(2)  =  P(2) 

PH(2,I1)  =  0.0 
GO  TO  290 
220  CONTINUE 

NSEGS  =  NOFSET(I)  -  1 

CALL  SPPLV2  (V,  P.  PSEGS(1 ,1 ,1) ,  NSEGS.  PT,  NI.  TI.  INT) 
IF  (INT  .KE.  1)  GO  TO  300 
II  =  II  +  1 
DY  =  PT(1)  -  P(l) 

DZ  =  PT(2)  -  P(2) 

AA  =  SQRT  (DY*DY  +  DZ*DZ) 

BB  =  DYeN0RM(2, J.K)  +  DZ*N0RM(3, J.K) 

IF  (BB  .NE.  0.0)  GO  TO  280 
PM(2.II)  =  0.0 
GO  TO  280 
280  CONTINUE 

PM(2,II)  =  AA  *  BB  /  ABS(BB) 

290  CONTINUE 

PMd.II)  =  X(I) 

300  CONTINUE 

IF  (II  .GT.  1)  GO  TO  320 
KORMd.J.K)  =  -0.0 
GO  TO  400 
320  CONTINUE 

CALL  SPLNT2  (SEGS,  PM,  II,  NDI,  ENDI) 

IF  (IK  .EO.  II)  GO  TO  340 
CX  =  SEGS(3,IK) 

CM  =  SEGS(4,IK) 

GO  TO  360 
340  CONTINUE 

IKK  =  IK  -  1 
CX  =  SEGS(7,IKK) 

CM  -  SEGS(8.IKK) 

360  CONTINUE 

NORMd.J.K)  =  -CM  /  SQRT  (CX*CX  +  CM*CM) 

400  CONTINUE 

600  CONTINUE 

RETURN 

END 

C  DECK  N0RMT6 
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SUBROUTINE  NQRMT5  (PSEGS) 

COMMON  /GEOM/  X , NSTATN ,Y ,Z , NOFSET ,LPP , BEAM , DRAFT , LCE , 

1  VCG , GM , DELGM . NEBLA , KPITCH , KRQLL ,KYAW .KYAWRL , AWP , VCB ,FBDX , FBDY , 

2  FBDZ , NFREBD , XPT , YPT , 2PT , NPTS , LCB , GML . ASTAT , BSTAT , TITLE . M ASS , 

2  DISPLM,IP1TCH,IR0LL,IYAW,1VAWRL,CHEAVE,CP1TCH,CHEAPI,CR0LL, 

2  AREAMX.WSURF, GIRTH, FBDZV.DBLWL.TLCB 

INTEGER  NSTATN , NOFSET ( 25 ) . NFREBD .NPTS 
CHARACTER*4  TITLE(20) 

REAL  X(25).Y(10,2S),Z(10.2B), FBD2V(8 , 10 ) , LPP , BE AM . DBLWL , TLCB , 

2  DRAFT, LCF, VCG, GM, DELGM, NEBLA, KPITCH, KROLL.KYAW, KYAWRL, AWP, VCB, 
2  FBDX(10),FBDY(10) . FBDZ( 10) . XPT( 10) ,YPT(10) ,ZPT(10) , LCB, GML, 

4  ASTAT(2S) ,BSTAT(25 ) .MASS .DISPLH , IPITCH , IROLL. lYAW . 

6  1 Y AWRL , CHEAVE , CPITCH . CHEAPI , CRQLL , AREAMX , WSURF , GIRTH ( 25 ) 

COMMON  /TWOD/  YY,  ZZ.  ENN,  ISTA 
INTEGER  ISTA 

REAL  YY(10,2S) ,2Z(10,2S) , ENN (4, 10 ,25) 

DIMENSION  PsEGS(8,y.25)  ,  CC(14) 

DIMENSION  V(2),  P(2),  PT(2) ,  PM(2,5),  SEGS(8,4).  NDI(2), 

2  ENDI(2,2) 

DATA  NDI,  ENDI  /  Zfl,  4*0. 0  / 

♦  calculate  2d  normals  (n2,  n3,  n4)  at  midpoints 

T  =  0.6 

T2  -  0.25 

T3  =  0.126 

DO  100  K=l, NSTATN 

NP  =  NQFSET(K)  -  1 

IF  (NP  .LT.  1)  GO  TO  100 

DO  50  J=1,NP 

CALL  CUBC02  (PSEGSd  .  J  .K)  ,  CC) 

YYd.K)  =  CC(1)*T3  +  CC(3)*T2  +  CC(6)*T  +  CQ(7) 

ZZ(J,K)  =  CC(2)*T3  +  CC(4WT2  +  CC(6)»T  +  CC(8) 

CY  =  CC(  9)*T2  +  CC(11)*T  +  CC(6) 

CZ  s  CC(10)*T2  +  CC(12)*T  +  CC(6) 

DEN  =  SQRT  (CY*CY  +  CZ*CZ) 

IF  (DEN  .GT.  0.0)  GO  TO  40 
EHN(2,J,K)  =  0.0 
ENN(3,J.K)  -  0.0 
GO  TO  45 
40  CONTINUE 

ENN(2,J,K)  =  -CZ  /  DEN 
ENN(3,J,K)  =  CY  /  DEN 
45  CONTINUE 

ENN(4,J,K)  =  YY(J,K)*ENN(3.J,K)  -  Z2(J,K)t‘ENN(2, J ,K) 

60  CONTINUE 

J  =  NP  +  1 

YY(J,K)  =  0.6  *  YY(NF,K) 

ZZ(J,K)  =  0.0 
ENH(1,J,K)  =  0.0 
ENN(2,J,K)  =  0.0 
ENN(3.J,K)  =  -1.0 
ENN(4,J,K)  =  -YY(J,K) 

ICO  CONTINUE 

*  calculate  longitudinal  normals  (nl)  at  midpoints 

DO  600  K=l, NSTATN 
NP  =  NOFSET(K)  -  1 
IF  (NP  .LT.  1)  GO  TO  600 
NSEGS  =  NP 
IB  =  K  -  2 

IF  (IB  .GT.  1)  GO  TO  160 
IB  =  1 

IF  (HOFSET(l)  .LT.  2)  IB  =  2 
150  rnilTTMIIR 

iE“='iB  +  4 

IF  (IE  .LT.  NSTATN)  GO  TO  200 
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IE  =  NSTATN 

IF  (NOFSET(NSTATH)  .LT.  2)  IE  =  NSTATN  -  1 
IB  =  IE  -  4 
200  CONTINUE 

DO  400  J=1,NP 
II  =  0 

P(n  =  YYfJ.K) 

P(2)  =  ZZ(J.K) 

V(n  =  EHN(3.J.K) 

V(2)  =  -ENN(2,J,K) 

DO  300  I=IB.IE 

IF  (I  .NE.  K)  GO  TO  220 

II  =  II  +  1 

IK  =  II 

PT(1)  =  P(l) 

PT(2)  =  P(2) 

PM(2.II)  =  0.0 
GO  TO  290 
220  CONTINUE 

NSEGS  =  NOFSET(I)  -  1 

CALL  SPPLV2  (V,  P,  PSEGSCi  ,  1 .1) ,  NSEGS.  PT,  NI,  T1 ,  INT) 

IF  (INT  .KE.  1)  GO  TO  300 

II  =  II  +  1 

DY  =  PT(1)  -  P(l) 

DZ  =  PT(2)  -  P(2) 

AA  =  SQRT  (DY*DY  +  D2*DZ) 

BB  =  DyfENN(2,J,K)  +  DZ*ENN(3, J ,K) 

IF  (BB  .NE.  0.0)  GO  TO  280 
PM(2,II)  =  0.0 
GO  TO  290 
280  CONTINUE 

PH(2,II)  =  AA  *  BB  /  ABS(BB) 

290  CONTINUE 

PMd.II)  =  X(I) 

300  CONTINUE 

IF  (II  .GT.  1)  GO  TO  320 
ENNU.J.K)  =  -  0.0 
GO  TO  400 
320  CONTINUE 

CALL  SPLNT2  (SEGS,  PM.  II.  KDI ,  ENDI) 

IF  (IK  .EO.  II)  GO  TO  340 
CX  =  SEGS(3,IK) 

CM  =  SEGS(4.IK) 

GO  TO  360 
340  CONTINUE 

IKK  =  IK  -  1 
CX  =  SEGS(7,IKK) 

CM  =  SEGS (8, IKK) 

360  CONTINUE 

ENNd.J.K)  =  -CM  /  SQRT  (CX»CX  +  CH*CM) 

400  CONTINUE 

500  CONTINUE 

RETURN 

END 

C  DECK  ORAO 

SUBROUTINE  OKAO  (IM,NL,KU,MOTV,MOTL,RAO.PHS,NMOT,HOMEGA. 

2  RADDEG.IPHS) 

*  This  routine  obtains  the  six  degree  ol  freedom  response  amplitude 

*  operators  and  phase  angles  (degrees)  for  naves  from  both  port 

*  and  starboard  headings . 

•*>  W.G. MEYERS,  DTNSRDC,  100E77 

COMPLEX  MOTV ( NHOT , NOMEG A ) . MOTL ( NHOT , HDMEG A ) , TFN 
DIMENSION  RAOCHOMEGA) .PBS(MOMEGA) 

DO  10  I=NL.IU 

TF  dM  .EO.  1)  TFN  =  MOTV(l.I) 

IF  (IM  .EQ.  2)  TFN  =  MOTL(l.I) 

IF  (IM  .EQ.  3)  TFN  =  M0TV(2,I) 
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IF  (IM  .EQ.  4)  TFN  =  M0TL(2,I) 

IF  (IM  .EQ.  5)  TFN  =  M0TV(3,I) 

IF  an  .EQ.  6)  TFN  =  MQTL(3,I) 

IF  (IM  .GT.  3)  TFN  =  TFN  ♦  RADDEG 

CALL  RAOPHA  (TFN , RAO (I) .PHS(I ), RADDEG , IPHS ) 
10  CONTINUE 

RETURN 

END 


SUBROUTINE  ORGRAO  (RLANG , KRANG , RLANS , MOTV , MOTL . NOMEGA , IM , RAO ,PHS , 
2  RADDEG) 

DIMENSION  RLANG(8) ,RAa(30,6) ,PHS(30,6) 

COMPLEX  M0TV(3,30) ,M0TL(3,30,8) ,CTFN 

DO  70  IW=1, NOMEGA 

GO  TO  (10,20,30,40,60,60) ,IM 

*  surge 

10  CALL  RAOPHA  (MOTV( 1 , IW) , RAO (IW , IM) ,PHS(IW , IM) , RADDEG , 1) 

GO  TO  70 


* 


sway 

20  CALL  TFNFIT 
CALL  RAOPHA 
GO  TO  70 


(RLANG, NRANG, RLANS, MOTL, 1 ,IW,CTFN) 
(CTFN,RAD(IW.IM),PHS(IW,IM), RADDEG, 1) 


*  heave 

30  CALL  RAOPHA  (M0TV(2 ,IW) ,RAO(IW, IM) ,PHS (IW , IM) .RADDEG , 1) 
GO  TO  70 

roll 

40  CALL  TFNFIT  (RLANG, NRANG, RLANS, MOTL, 2, IW.CTFN) 

CTFN  =  RADDEG*CTFN  ,  ^  s 

CALL  RAOPHA  (CTFN.RAO(IW,IM) .PHS(IW,IM) .RADDEG, 1) 

GO  TO  70 


♦  pitch 

60  CTFN  =  RADDEG»M0TV(3,IW)  . 

CALL  RAOPHA  (CTFN ,RAO(IW ,IM) ,PHS(IW, IM) .RADDEG , 1 ) 
GO  TO  70 


* 


yaw 


60 


70 


CALL  TFNFIT  (RLANG .NRANG .RLANS .MOTL, 3 , IW, CTFN) 


CTFN  =  RADDEG*CTFN 

CALL  RAOPHA  (CTFN, RAO (IW, IM) , 

CONTINUE 


PHSdW.IM)  .RADDEG,  1 


) 


RETURN 

END 


C  DECK  OUTPUT 

SUBROUTINE  OUTPUT (TIMADR ,TRAO , TRMS ) 

COMMON  /DATINP/  OPTK ,MOTN .BSCFIL.VLACPR.RAOPR.RLDMPR.DISPLMT , 
2  LRAOPR . ADRPR , ORGOPTN . GMNOM . KG . STATN ( 26 ) , N SOFST (26) 

2  NLEWF(2B),HLFBTH(10,26) , WTRLNE( 10 , 26) ,BLEWF(2B) ,T1XWF(2B) , 

2  AREAlK2b5 ,NPTL0C.PTKUMB(10) ,PTNAME,XPTL0C(10) ,YPTLOC(10) , 

2  ZPTLOCaO) ,NBB,FBNUMB(10) ,FBNAME,XPTFBD(10) ,YPTFBD(10) , 

2  ZPTFBD(IO) ,FBCDDE(10) ,FBTYPE,RD0T(10) .VKDES.FNDES, 

^  CHARACflRirPTHAME(8,10),FBHAME(8.10).STATHM(6).FBTYPE(3  10) 
INTEGER  OPTS ,MOTH ,ESCFIL,VLACPRjRADPR. ADRPR, RLDMPR.FBCODE, 

2  fbnumbVptnumbVorgoptn’""’ 


96 


REAL  KG 


COMMON  /lO/  SySFIL,POTFIL,COFFIL,LCOFIL,ICARD,TEXFIL,lPRIN, 

2  SCRFIL,HPLFIL,LRAFIL,0RGFIL.RA0F1L,RMSFIL.SEVF1L,SPDFIL. 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL,POTFIL,CQFFIL.LCOFIL.ICARD,TEXF1L,IPRIN, 

2  SCRFIL , HPLFIL .LRAFIL .ORGFIL . RAOFIL .RMSFIL.SEVFIL , SPDFIL . 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /LOADS/  NLOADS ,SWGHT(2S) .SMASS(25) . XLDSTN ( 10) . XLDXPT(2B) . 
2  LSTATH(26) 

COMMON  /SMPSYS/  FIS , AS .SIS .SOS, SDS .HALOS. DEV ,PRN .SMPPS .SMPIS , 

2  SMPOS , SMPDS . SHPTYPS , SHIPS .VARS , CYCLS . TITLES . OPTION , LSIS , LSOS . 

2  LSDS , LHALOS . LDEV , LPRN . LSMFPS .LSMPIS .LSMPOS , LSMPDS .LSHPTYPS . 

2  LSHIPS.LTITLES 
CHARACTER+160  AS 

CH ARACTER*80  FIS . SIS . SOS , SDS .TITLES 

CHARACTER*20  HALOS .DEV .PRN . SMPPS .SMPIS .SMPOS .SMPDS . SHPTYPS 
CHARACTER  SHIPS*6. VARS*2,CYCLS+2 
INTEGER+2  OPTION 

IF  (ORGOPTN  .EQ.  1)  GO  TO  10 

IF  (RAOPR  .GT.  0)  THEN 

AS  =  ’(/4X, "CALLING  RAGOUT")’ 

WRITE  (*.AS) 

WRITE  (TEXFIL.AS) 

CALL  RAGOUT 
ENDIF 

IF  (NLOADS. GT.O  .AND.  LRAOPR.GT.O)  THEN 
AS  =  •(/4X, "CALLING  LRAOUT")’ 

WRITE  (‘.AS) 

WRITE  (TEXFIL.AS) 

CALL  LRAOUT 
ENDIF 

IF  (0PTN.LT.6  .OR.  RAOPR. NE. 2)  THEN 
AS  =  '(/4X. "CALLING  RMSOUT")’ 

WRITE  (♦.AS) 

WRITE  (TEXFIL.AS) 

CALL  RMSOUT 
ENDIF 

10  CONTINUE 

RETURN 

END 

C  DECK  PADD 

SUBROUTINE  P ADD ( Z . IDZ , X . IDX . Y . IDY ) 

♦  subroutine  to  add  two  polynomials 

♦  based  on  SSP,  P.171 

*  INPUT 

♦  X(J),J=1,IDX  -  coetJicients  of  polynomial  with  terms 

*  X(J)*Tee(J-l) 

♦  Y(J),3=1,IDY  -  coefficients  of  polynomial  with  tenas 

*  YCD^Te^d-l) 

*  OUTPUT 

*  Z(J).J=1.IDZ  -  coefficients  of  polynomial  with  terms 

♦  Z(J)*T**(J-1) 

DIMENSION  I(6),Y(6),Z(b) 

NDIM=MAXO(ipX,ipY) 

IK  (MDln  .Le.  0)  GO  TO  50 
30  CONTINUE 


t 


DO  80  I=1,NDIH 
IF  (1  .GT.  IDX) 

GO  TO  60 

IF  (I  ,GT.  IDY) 
2(I)  =  X(T)+Y(I) 

GO  TO  80 

GO  TO  70 

60 

CONTINUE 

z(i)=y(i) 

GO  TO  80 

70 

CONTINUE 

Z(I)=X(I) 

80 

CONTINUE 

90 

1DZ=NDIM 

RETURN 

END 

DECK 

PDER 

SUBROUTINE  PDER(Y 

,  IDY, X. IDX) 

*  subroutine  to  calculate  derivative  ol  polynomial  in  polynomial  form 

*  based  on  SSP ,  P.176 

»  INPUT 

*  X(J),J=1,1DX  -  coefficients  of  polynomial  «ith  terms 

*  X(J)*T»*(J-1) 

*  OUTPUT 

*  Y(J),J«1,IDY  -  coefficients  of  polynomial  oith  terms 

*  Y(J)*T**(J~1) 

DIMENSION  X(4),Y(3) 

IDy=0 

IF  (IDX  .LE.  1)  RETURN 

IDY=IDX-1 

EXPT=0 . 0 

Ul)  2  1  =  1,  IDY 

EXPT=EXPTtl.O 

Y(I)=EXPT*X(I+1) 

2  CONTINUE 

RETURN 

END 

C  DECK  PINT 

SUBROUTINE  PINT(Y ,IDY,X,IDX) 

*  subroutine  to  integrate  polynomial 

*  based  on  SSP,  P.lTe 

*  INPUT 

e  X(J),J=1,IDX  -  coefficients  of  polynomial  uith  terms 

*  X(J)*T*etJ-l) 

*  OUTPUT 

*  Y(J),J=1,IDY  -  coefficients  of  polynomial  with  terms 

*  Y(J)eT*e(J-l) 

DIMENSION  1(8), Y(9) 

IDY=IDX+1 

Y(1)=0.0 

IF  (IDX  .LE.  0)  RETURN 

EXPT=1.0 

DO  3  1=2, IDY 

Y(I)=X(I-1)/EXPT 

EXPT=EXPT+1.0 

3  CONTINUE 

RETURN 

MjWkU 
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C  DECK  PMPY 

SUBROUTINE  PMPY(Z,IDZ,X.1DX.Y,1DY) 


*  subroutine  to  multiply  two  polynomials 

*  based  on  SSP ,  P  .172 

*  INPUT 

*  X(J),J=1,IDX  -  coetf iciants  ol  polynomial  with  terms 

*  X(J)*Tf*(J-l) 

*  Y(J),J=1,IDY  -  coefficients  of  polynomial  with  terms 

*  Y(J)aT*a( J-1) 

*  OUTPUT 

*  Z(J),J=1,IDZ  -  coefficients  of  polynomial  with  terms 

it-  2(J)+Ta*(J-l) 

DIMENSION  X(B) ,Y(4) ,2(8) 

IF  (IDX*IDY  .LE.  0)  GO  TO  10 

lDZ=IDXtIDY-l 

DO  1  1=1 ,IDZ 

2(I)=0.0 

1  CONTINUE 

DO  2  1  =  1, IDX 
DO  3  J=1,IDY 
K-ItJ-l 

2(K)=2(K)+XCI)*Y(J) 

3  CONTINUE 

2  CONTINUE 
RETURN 

10  CONTINUE 
IDZ=0 

RETURN 

END 

C  DECK  FRAO 

SUBROUTINE  PRAO  (IM ,NL,NU ,MOTV ,MOTL,XPT,YPT ,ZPT,RAOl ,PHS1 ,RA02 , 
2  PHS2.NMOT.KPLANE,NOMEGA.RADDEG,IPHS,OMEGAE,GRAV) 

*  This  routine  obtains  the  longitudinal,  lateral  and  vertical 

*  "NOTIONS  AT  A  POINT"  rao  and  phase  angles  for  waves  from  both 

*  port  and  atarboard  headings , 

*  W.G, MEYERS,  DTHSRDC,  100677 

COMPLEX  MOTV ( NMOT , KOMEG A ) , MOTL (NHOT , NOMEG A ) , 

2  SURGE, SWAY , HEAVE , ROLL, PITCH .YAW ,TFN ,LATACC 

DIMENSION  RAOI(NONEGA) ,PHSUHOHEGA),RA02(NOHEGA) ,PH52(N0HEGA) , 
2  OKEGAE(NONEGA) 

DO  50  I=SL,KU 
SURGE  =  MOTV (1,1) 

SWAY  =  M0TL(1,I) 

HEAVE  =  M0TV(2,I) 

ROLL  =  M0TL(2,I 
PITCH  =  M0TV(3,I) 

YAW  =  M0TL(3,I) 

DO  30  J=1.NPLANE 
IF  (J  .EQ.  1)  GO  TO  10 
SWAY  =:  -  SWAY 
ROLL  =  -  ROLL 
YAW  =  -  yaw 
10  CONTINUE 

IF  (IM  .EQ.  1)  TFN  =  SURGE  -  YPT*YAW  +  ZPT*PITCB 

IF  (IM  .EQ.  2)  TFN  =  SWAY  -  ZPT*R0LL  +  XPT*YAW 

IF  (IM  .EQ.  3)  TFN  =  HEAVE  -  XPT*PITCB  +  YPTaROLL 

IF  (IM  .EQ.  IB)  THEN 

IF  (J  -EQ.  1)  CON  =  -  OMEGAE(I)  •  OMEGAE(I)  /  GRAV 
T.ATACC  =  CON  •  (SWAY  -  ZPT  ♦  ROLL  +  XPT  *  YAW) 

TFN  =  LATACC  +  ROLL 


99 


ENDIF 

:F  (J  .EQ.  1)  CALL  RAOPHA  (TFN  ,  RAOl  (1 1  ,  PHP 1  (I ,  RADDEG  ,  I PHS  ) 

IF  (J  .EQ,  2)  CALL  RAOPHA  (TFK , RA02 (1 ) , rH52(l ) , RADDEG , IPHP ) 

30  CONTINUE 

RETURN 

END 

C  DECK  PRELIM 

SUBROUTINE  PRELIM 

COMMON  /lO/  SYSFIL,P0TFIL,C0FFIL,LC0FIL,ICARD.TEXFIL,IPR1N, 

2  SCRFIL.HPLFIL.LRAFIL.ORGFIL.RAOFIL.RMSFIL.SEVFIL.SPDFIL, 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL,POTFIL,COFF1L,LCOFIL.1CARD.TEXFIL,IPRIN, 

2  SCr.-IL.HPLFlL,LRAFIL,ORGFIL,RAOFlL,RMSFIL,SEVFIL,SPDFIL. 

2  S'-iFIL.LACFIL,LAEFlL 

COMMON  /PHYSCO/  I I . TPI . P I . PIOT .DEGRAP . RADDEG , VKMETR , HETRVK , GRAY , 

2  RHO . GNU , RHOS , RHOF , GNUS , GNUF .FTMETR .PUNITS , REYSCL 
COMPLEX  II 

CHARACTER**!  rUNITS(2) 

REAL  TPI .PI .PIOT, DEGRAD, RADDEG. VKMETR, HETRVK, GRAV, RHO. GNU, RHOS. 

J  RHOF, GNUS, GNUF, FTMETR 

•  PHYSCO  definitions 

II  =  (0.0.  1.0) 

PI  =  3.J41E927 
TPI  =  2*PI 
PIOT  =  PI/2 
DEGRAD  =  Pl/ieO 
RADDEG  =  1. /DEGRAD 
FTMETR  =  .3048 
VKMETR  =  1.689*FTMETR 

♦  10  definitions 

SYSFIL  =  1 

POTFIL  =  2 

COFFIL  =  3 

LCCFIL  =  4 

ICARD  =  6 

TEXFIL  =  6 

IPRIN  •=  7 

SCRFIL  =  8 

HPLFIL  =  9 

LRAFIL  =10 
ORGFIL  =  11 
RAOFIL  =  12 
RMSFIL  =  13 
SEVFIL  =  14 
SPDFIL  =  16 
SPTFIL  =  16 
LACFIL  =  17 
LAEFIL  =  18 

RETURN 

END 

C  DECK  PSPLC 

SUBROUTINE  PSPLC  (NOMEGA .OMEGA .OMEGAE.VK .HDNG .DEGRAD , GRAV .VKMETR, 
2  DUMl , DUM2 , RAO , S , R , NWEVN , WEVN , ARLC 1 . ARLC2 , ARLC3 . RLC ) 

DIMENSION  0MEGA(30) ,0MEGAE(3O) ,DUM1{30) .DUH2{30) ,RA0(30)  S(30) . 

2  R(30) ,WEVN(100) ,ARLC1(100) ,ARLC2(l00) ,ARLC3(100) .RLC(IOO) 

CON  =  VKMETR*VK*COS(HDNG*DEGRAD)/GRAV 

VI  =  CMEGA(NOMEGA)  +  1 

TF(AnSfcnNI  .GT.  0.000001)  Vl=l . /(2*C0H ) 

IF(ABS(CON)  .GT.  0.000001)  V2=1./C0N 
KR1=0 


KR2  =  0 
NR3  =  0 

DO  40  1=1 .NOMEGA 
XJACOB  =  18 

IF  (OMEGA(l)  .NE.  Wl)  XJACOB  =  ABS(  1 . /( 1  . -2*DMEGA  (.1  )  *CON ) ) 
IF  (XJACOB  .GT.  18.)  XJACOB  =  10. 

R(I)  XJAC0B*RA0(I)*S(1) 

IF  (ABS(CON)  .GT,  0. 000001)  GO  TO  10 

*  region  1 


NRl  =  KR1-*1 
CO  TO  40 

10  IF  (OMEGA(I)  .GT.  yi)  GO  TO  20 

♦  region  1 

NRl  =  KRl+l 
GO  TO  40 

20  IF  (OMEGA(l)  .GT.  W2)  00  TO  30 


*  region  2 


NR2  =  NR2-t  1 
GO  TO  40 

*  region  3 

30  J)R3  =  NRB  +  l 
40  CONTINUE 

DO  60  I=1,NWEVN 
ARLCKI)  =  0. 

ARLC2(I)  0. 

ARLC3(I)  =  0. 

60  CONTINUE 

*  interpolate  longcrested  response  spectrum 

IF  (HRl  ,LT.  2)  GO  TO  60 

CALL  IHTRPL  (NRl .0MEGAE,R,NWEVN,WEVN,ARLC1) 

60  IF  (NR2  .LT.  2)  GO  TO  80 
«  »  NRl+1 
N  =  NR1+NR2 
L  =  N  +  1 
DO  70  I=M,N 
I.  =  L  -  1 

DUMl(I)  «=  OMEGAE(L) 

DUM2a)  =  R(L) 

70  CONTINUE 

CALL  INTRPL  (KR2 ,DU«1 (M) ,DUM2(M) .NWEVN .WEVN , ARLC2) 

80  IF  (KR3  .LT.  2)  CO  TO  90 

CALL  INTRPr(NR3.0MEGAE(H),R(M),NWEVN,WEVN,ARLC3) 

90  CONTINUE 

e  sum  longcrested  spectra  in  regions  1,  2  and  3 
DO  100  1=1,NWEVN 

RLC(I)  r-  aRLCI(I)  +  ARLC2(I)  +  ARLC3(I) 

100  CONTINUE 

RETURN 

END 

C  DECK  PSPSC 

SUBROUTINE  PSPSC  (NWEVN , WEVN ,RLC,NBETA, B2.NLCH , IPH .ERLC.ERSC , 
2  TOELC.TOESC.TPl) 

DIMENSION  WEVNCNWEVN) ,RLC(NyEVN,HBETA) .B2{NLCH) ,ERLC(KWEVN) , 

2  ERSC(NWEVN) 

KH  =  IPH  +  6 
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IF  (KH  .GT.  24^  KH  =  KH  '  24 
DO  20  I^l.NWEVN 
K  =  IPH  -  1 
ERSC(l)  =  0. 

DO  10  L=1.NLCH 
K  =  K  +  1 

IF  (K  .GT.  241  K  =  K  -  24 
ERSCvI)  »  LRSC(I)  H  B2(L.)»RLC(1  ,K) 

10  CONTINUE 

ERLC(I)  =  RLCd.KH) 

20  CONTINUE 

CALL  TEPEAK  (NWEVK  ,  V'EVN  .  ERl-C  ,TOELC  .TFI ) 

CALL  TEPEAK  (NWEVN ,WEVK .ERSC .TOESC.TPl) 

RETURN 

END 

C  DECK  PVAL 

SUBROUTINE  PVAL  ( VAL , ARC , POLY . IDPOLY) 

•*  subroutine  to  evaluate  polynomial 

*  based  on  SSP,  P.174 

*  INPUT 

*  POLY(  J ) .  J  =  1 .  IDOPLY  -  coefficients  of  p,olynomial  vith  teims 

*  P0LT(J)*T**(J-1) 

*  ARG  -  point  at  whxch  polynomial  is  to  be  evaluated 

*  OUTPUT 

*  VAL  -  value  of  polynomial  at  t=arg 

DIMENSION  PDLYO) 

VALtO.O 

J=IDPCLY 

1  CONTINUE 

IF  (J  .LE.  0)  GO  TO  2 
VAL=VAL*ARG+POLY( J) 

J«J-1 
GO  TO  1 

2  CONTINUE 

RETURN 

END 


C  DECK  RAGOUT 

SUBROUTINE  RAOOUT 

COMMON  /DATINP/  DPTN .MOTN .ESCFIL. VLACPR.RAOPR, RLDMPR.DISPLHT . 

2  LRAOPR , ADRPR , ORGDPTN . GMNOH ,KG .STATN(26) , NSOFST ( 2f.) , 

2  NLEWF(25),KI.FBTHdO,2b)  . VI RLNE( lO , 2S)  .BLEWFvIB)  ,TLEWr(25;  , 

2  AREALF(25) .NPTLOC ,PTNUMB(10) ,PTNAME.XPTLOC( 10) ,YPTL0C(10) , 

2  ZPTLOC(lO) ,NBB,FBNUMB(10).FBNAME,XPTFBD(]0) .yptfbdcio) , 

2  ZPTFBD(IO) .FBCODE(lO) ,FBTYPE.RDOT( 10) , VKDES .FKDES , 

2  STATNM.STATIS 

CHARACTER*^  PTNAMEO.IO) ,FBNAME(e , 10) ,SVATNM(b) ,FBTYPE(3 . 10) 
INTEGER  OPTN , MOTN , BSCFIL .VLACPR.RAOPR . ADRPR . RLDMPR . FBCODE . 

2  FBNUHB.PTKUMB.ORGOPTN 
REAL  KG 

COMMON  /ENVIOR/  VK .NVK .MU .NMU .OMEGa .NOMEGA . SIGMA .NSICMA .SIGWH , 

1  NSIGWH  . TMODAL .  NTMOD  .  NRAKG  ,  RANG , RLANO  .S  .NNitU ,  FRNUK ,  VFS 
INTEGER  NVK.NMU.NOKEGA .NSIGKA .NSIGWH .NTHOb , NR ANG ,NNMC CU) 

REAL  VK(8) ,MU(37,e) .0MEGA(30) .SICHACO) ,S1CHH(4) .THQUAL(8' , 

2  RANG(8) ,RLAHG(8) ,S(30,8) .FRNUK(8) ,VFS(R) 

COMMON  /GEOM/  X .NSTATN ,Y ,Z .NOFSET.LPP .BEAK .DRAFT ,LCF . 

1  VCG ,GM .DELGM , NEBLA .KPITCH .KROLL .KYAU.KYAWRL. AWP , VCB .FBDX ,FBDY , 

2  rnn?  iifrfbd , XPT . YPT .ZPT . N?TS . LCB . GML , ASTAT . EST AT .TITLE . MASS . 

2  DisPLM.IPITCH.lROLL.IYAW.lYAWRL.CHEAYE.CPlTCH.CHEAHI .CKULL. 

2  AREAMX . WSURF .GIRTH . FBDZV , DBLWL , TLCB 
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INTEGER  N5TATN ,H0FSET(2& ) . NFREBD . HPTS 
CKARACTER*4  T1TLE(20) 

REAL  X(:6) .Y (10,26 ).Z( 10,25) .FBDZV(8 , 10) .LPP , BFAM ,DBLUL , TLCB . 
DRAFT, LCF.VCG, CM, DELGM.NF.BLA .KPITCH .KR0LL,KVAU . KYAWBL , AWT  . VCD , 
FBDX(10),FBDY(10) ,FBDZ(10),XPT(10) ,YPT(10) ,ZPT(10) ,LCB.GML, 
ASTAT(25) ,BSTAT(26) .HASS .DISPLH ,IPITCH . IR0LL,1YAW , 

I YAWRL, CHEAVE , CPITCH . CHEAPI , CROLL , AREAMX ,WSURF , GIRTH(2S) 

COMMON  /lO/  SYSFlL,POTFIL,CnFFIL,LCOF]L.lCARD,TEXFIL,IPRlN , 
SCRF1L,HPLFIL,LRAF1L,0RGFIL,RA0FIL,RHSF1L.SEVF1L.SPDF1L, 

SPTFIL  LACFIL  LAEFIL 

IKTEGER  SYSFIL,POTF1L,COFFIL.I.COF1L,1CARD,TEXFJL,1PRIN , 
SCRF1L.HPLF1L.LRAF1L,0RGFIL,RAQF1L,RMSF1L,SEVFIL,SPDF1L, 

SPTFIL, LACFIL, LAEFIL 

COMMON  /PHY, SCO/  II ,TPI , PI ,PIOT, DEGRAD .RADDEG .VKMETR ,hETRVK ,GRAV , 
RHO . GNU . RHOS , RHOF .GNUS . GNUF , FTMETR , PUNITS , REYSCL 
COMPLEX  31 

CHARACTER*4  PUNITS(2) 

REAL  TPI , PI . PIOT , DEGRAD , RADDEG . VKMETR , KETRVK , GR AV . RHO . GNU , RHOS , 
RHOF, GNUS, GNUF, FTMETR 

COMMON  /SMPSYS/  FIS , AS , SIS . SOS, SDS .HALOS ,DEV ,PRN , SHPPS , SHPIS , 
SMPOS ,SMPDS,SHPTYPS , Sill  PS, VARS. CYCLS, TITLES, OPTl ON ,LS3S ,LSOS, 
LSDS .LHALOS ,LDEV .LPRN .LSMPPS ,LSKP1S,LSKP0S .LSMPDS , LSHPTYPS , 
LSHIPS.LTITLES 
CHARACTER+160  AS 

CHARACTER*80  FIS , SIS . SOS .SDS .TITLES 

CHARACTF.R*20  HALOS .  DEV  .  PRN  .SKPPS , SHPIS  .  SMPOS  ,SHPDS ,  SHPTYPS 
CHARACTER  SHIPS*6 , VARS»2 , CYCLS*2 
INTEGER^Z  OPTION 

COMMON  /STATE/  LAT . VRT , LOADS . ADORES .SALT , HEAD . EXRCLL , BKEEL 
LOGICAL  LAT , VRT , LOADS , ADORES . SALT , HEAD , EXROLL , BKEEL 

COMPLEX  HOTVO.BO)  . M0TL(3 . 30 . 8 )  ,H JV(3 . 30)  . H  JL( 3 , 30)  .H7(30) 
DIMENSION  0MEGAE(30) ,RA0(30,6) ,PHS(50,6) ,R(30) ,KLCaLC(h) , 

2  1M0DL(4) 

CHARACTER*4  METER 

DATA  METER  /'METE'/ 

DATA  EPS  /O.OOOl/ 

DO  6  IS=1.NSIGWH 
SWH  =  SIGWH(IS) 

IF  CPUNlTS(l)  .ME.  METER)  SWH  =  SWH*FTMETR 

*  Blgnijicuit  ¥ftv«  height  rai\gea  below  eir«  in  meters 

4'  sea  state  i 

IP  (SWH  .LE.  0.69)  PER  =  6.0 

*  sea  state  2 

IF  (SWH. GT. 0.69  .AND,  SWH. LE. 1.26)  PER  *  6.0 

«  sea  state  3 

IF  (SWH.GT.l .26  .AND,  SWH. LE. 1.73)  PER  =7.0 

»  sea  state  4 

IF  (SHH.GT.i.73  .AND.  SWH. LE. 2. 24)  PER  =  7.0 

»  sea  state  6 

IF  (SWH. GT. 2. 24  .AID.  SWH. LE. 3. 97)  PER  =  9.0 

sea  state  6 

IF  (SWH. GT. 3, 97  .AND.  SWH. LE. 6. 34)  PER  =  11.0 
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sea  state  7 


IF  (SWH.GT.6.34  .AND.  SWH . LE . 12 . 29)  PER  =15.0 

*  sea  state  8 

IF  (SWH. GT. 12. 29  .AND.  SWH . LE . 18 . 77)  PER  =  19.0 

*  greater  than  sea  state  ft 

IF  (SWH  .GT.  18.77)  PER  =  19.0 

IF  (PER  .LT.  TMQDAL(l))  PER  =  TMODAL(l) 

IF  (PER  .GT.  THQDAL(NTMQD))  PER  =  TMQDAL(NTMOD) 

IMODL(IS)  =  1 
DO  3  IT=1.HTMQD 

IF  (ABS(PER-TMQDAL(IT))  .LT.  EPS)  IMODL(IS)  =  IT 
3  CONTINUE 
r,  CONTINUE 

FIS  =  SDS(1 :LSDS)//‘ .ORG' 

OPEN  (UNIT=ORGFIL, FILE=FIS.FORM= ’UNFORMATTED ■,STATUS= ’UNKNOWN ’ ) 
FIS  =  SDS(1:LSDS)//’ .RAO’ 

OPEN  (UNIT=RAQFIL.FILE=FIS ,FORM=’ UNFORMATTED ’ ,STATUS= 'UNKNOWN ’ ) 

READ  (QRGFIL)  TITLE , NVK , NMU . NOMEGA .OMEGA. NRANG , RLANG .VRT . LAT , 

2  ADDRES , LPP . BEAM .DRAFT .DISPLM , GM .DELGM.KG .KROLL . LCB .GRAV , RHO . 

2  VKDES.VKINC.DBLWL 

WRITE  (RAOFIL)  TITLE , NOMEGA .OMEGA . NVK . NMU .NSIGWH . STATIS . 

2  (STATNM(I) ,1=1,3) , LPP , BEAM, DRAFT .DISPLM, GM,DELGM , KG , KROLL, 

2  LCB, DBLWL, GRAV 

DO  300  IV=1,NVK 
DO  200  IH=1.NMU 

READ  (QRGFIL)  VKNOTS,HEADNG,OMEGAE 

IF  (VRT)  READ  (QRGFIL)  MOTV 

IF  (LAT)  READ  (ORGFIL)  MOTL 

IF  (ADDRES)  READ  (ORGFIL)  HJV,HJL,H7 

HDHG  =  180.  -  HEADNG 

IF  (IH.GT.l  .AND.  IH.LT.NMU)  GO  TO  20 

*  iollosing  or  head  saves  -  lateral  mode  (sway .roll, yaw)  RAOS 

*  are  zero 

DO  10  IM=2,6,2 
DO  10  IW=1, NOMEGA 
RAO(IW,IM)  =  0. 

PHSdW.IM)  =  0. 

10  CONTINUE 

vertical  node  (surge  .heave  .pitch)  RAOS 
20  DO  30  IM=1,6,2 

CALL  ORGRAO  (RLANG, NRANG, 0. , MOTV, MOTL, NOMEGA, IM, RAO, PHS.RADDEG) 
30  CONTINUE 
40  DO  100  IS=1, NSIGWH 
KS  =  IMDDL(IS) 

IF  (IH.EQ.l  .OR.  IH.Eq.NMU)  GO  TO  80 

^  perform  roll  iteration  for  each  sea  state  and  for  the  specified 

*  statistic 

DO  60  IA=1, NRANG 
DO  60  IW=1,N0MEGA 

R(IW)  =  CABS(M0TL(2,IW,IA))**2  *  S(IW,KS) 

60  CONTINUE 

CALL  ALGRNG  (!;Ua77^, OMEGA, R. AREA) 

RLCALC(IA)  =  STAT.:  ■*SIGWH(IS)*SQRT(ABS(AREA))»RADDEG 
60  CONTINUE 

CALL  RLITR  (RLAiu  ,,;-.;NG.RLCALC,RLANS) 
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lateral  node  (sway .roll , yaw)  raos 


DO  70  IM=2.6,2 

CALL  ORGRAO  (RLANG,NRANG,RLANS,M0TV,MQTL,N0MEGA,1M,RA0,PHS, 
2  RADDEG) 

70  CONTINUE 
80  CONTINUE 

WRITE  (IPRIN.IOOO)  TITLE, VKNOTS.HDNG 
1000  FORMAT  ( IHl , / .28X , 20A4 . /// , 

2  45X, ‘RESPONSE  AMPLITUDE  OPERATORS  (RAOS) 

2  ‘AND  PHASES' .///.55X. 'SHIP  SPEED  =',F5.0,'  KNOTS’, 

2  /53X, 'SHIP  HEADING  =’ . 


if’ 

(PUNITS(l) 

.Eq. 

METER) 

WRITE 

(IPRIN.lOlO) 

SIGWH( 

IF 

(PUNITS(l) 

.NE. 

METER) 

WRITE 

(IPRIN.1020) 

SIGWH( 

SIGNIFICANT  WAVE  HEIGHT  =’, 
SIGNIFICANT  WAVE  HEIGHT  =’,FS.2, 


1030 


2 

2 

2 

2 


1010  FORMAT  (/42X,’SEA  STATE: 

2  FB.2, ’  METERS’ ) 

1020  FORMAT  (/42X,'SEA  STATE: 

2  ’  FEET ’ ) 

WRITE  (IPRIN,1030)  TMODAL(KS) .STATIS . (STATNM(I ) , 1=1 , 3) 

FORMAT  (54X, 'MODAL  PERIOD  =',F4.0,'  SECONDS' ,/,54X, 

■STATISTIC  =' ,F5.2, 

’  (■ ,3A4, ’)’ ,///,2X, 'OMEGA  OMEGAE ' ,9X , 'SURGE' , 14X ,' SWAY ’, 15X  , 
'HEAVE'  14X 

■ROLL' ,i6X,*PITCH' . 14X . ’ YAW ' , / , 18X .6( ' AMPL .  PHASE’ ,4X)/) 

DO  90  IW=1.N0MEGA 

WRITE  (IPRIN.2000)  OMEGA(IW) ,QMEGAE(IW) , (RAO(IW.IM) , 

2  PHS(IW.IM) .IM=1,6) 

FORMAT  (2F7.3.6(1PE12.4,0PF7.1)) 

CONTINUE 

WRITE  (IPRIN,2100) 

FORMAT  (//2X’N0TES:  1)  VERTICAL  RAOS  (SURGE, HEAVE, PITCH)  ARE  ’ 
'LINEAR  AND  INDEPENDANT  OF  SEA  STATE.'/  9X'2)  LATERAL  RAOS  ’ 
'(SWAY, ROLL, YAW)  ARE  NONLINEAR  AND  CHANGE  WITH  SEA  STATE  AND  ' 
'STATISTIC. ') 

IF  (PUNITS(l)  .Eq.  METER)  WRITE  (IPR1N,2110) 

IF  (PUNITS(l)  .NE.  METER)  WRITE  (IPRIN,2120) 

FORMAT  (9X'3)  AMPL.  IS  IN  (PHYS. UNITS/METER) ' ,2H**, '2  AND  PHASE 
*  IS  IN  DEGREES**) 

FORMAT  (9X’3)  AMPL.  IS  IN  (PHYS. UNITS/FOOT) ' ,2H'»*, '2  AND  PHASE  ’ 
'IS  IN  DEGREES. ■) 

WRITE  (IPRIN,2130) 

FORMAT  (9X’4)  HEADING  CONVENTION:  0  DEG=HEAD,  90  DEG=STBD  BEAM, 

' 180  DEG=FOLLOWING  SEAS . ' ) 

WRITE  (RAOFIL)  VKNOTS,HDNG,SIGWH(IS) ,TMODAL(KS) .OMEGAE, RAD, PHS 
IF  (IH.EQ.l  .OR.  IH.Eq.NMU)  GO  TO  200 
CONTINUE 
CONTINUE 
CONTINUE 


2000 

90 

2100 


2110 

2120*“ 


2130 


100 

200 

300 


CLOSE  (UKIT=ORGFIL) 
CLOSE  (UNIT=RAOFIL) 


RETURN 

END 


C  DECK  RAOPHA 

SUBROUTINE  RAOPHA  (TFN, RAO, PHS, RADDEG, IPHS) 

*  This  routine  obtains  a  response  amplitude  operator,  RAO,  and  a 

*  phase  angle,  PHS.  The  response  as  a  li  tion  of  time  can  be 

*  written  as-  RESP  =  sqRT(RAO)  *  COS(WEt‘T+PHS*DEGRAD) 

*  W.G. MEYERS,  DTNSRDC,  100777 

COMPLEX  TFH 

ARL  =  REAL  (TFN) 

AIM  =  AIMAG  (TFN) 

RAO  =  ARL'^ARL  +  AIM^AIM 

IF  (IPHS  .tig.  1)  PHS  =  ATAH2D  (AIK, ARL, RADDEG) 
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RETURN 

END 

C  DECK  RAOPHS 

SUBROUTINE  RAOPHS  (0MEGAE,RA01,PHS1,RA02.PHS2,IREC,IR,IV,IH,IPHS) 

COMMON  /DATINP/  OPTH,MOTN,BSCFlI.,VLACPR.RAOPR,RLDMPR,DISPLMT, 

2  LRA0PR,ADRPR.0RG0PTN,GMN0M,KG,STATN(25) ,NS0FST(26) , 

2  KLEWF(2E),HLFBTH(10.25) .WTRLKE(10 ,25) . BLEUF(25) ,TLEWF(25) , 

2  AREALF(2B) .NPTLOC .PTNUMB(IO) , PTNAME, XPTLOC( 10) .YPTLOCCIO) , 

2  ZPTLOC ( 10) ,NBB .FBNUMB ( 10 ) ,FBN AME , XPTFBD ( 10 ) , YPTFBDC 10 ) , 

2  ZPTFBD(IO)  .FBCQDEdO)  .FBTYPE.RDOTdO)  .VKDES  .FNDES  , 

2  STATNM.STATIS 

CHARACTER*4  PTNAME(8,10) ,FBNAME(8 , lO) .STATNM(5) ,FBTYPE(3 , 10) 
INTEGER  OPTN , MOTH  .  BSCFIL , VLACPR , RAOPR . ADRPR , RLDMPR , FBCODE , 

2  FBNUMB, PTNUMB.ORGQPTN 
REAL  KG 

COMMON  /ENVIOR/  VK.NVK, MU, NHU, OMEGA, NOKEGA, SIGMA, NSIGHA,SIGWH, 

1  NSIGWH , TMODAL , NTMOD . NRANG . RANG , RLANG , S , NNMU , FRNUM , VFS 
INTEGER  NVK,NMU, NOMEGA, NSIGMA, NSIGWH, NTMOD, NRANG, NNMU(8) 

REAL  VK(8) .MU(37,8) ,QMEGA(30) .SIGMAClO) ,SIGWH(4) ,TMDDAL(8) , 

2  RANG(8) ,RLANG(8) ,S(30,8) ,FRNUM(8) ,VFS(8) 

COMMON  /GEOM/  X ,NSTATN ,Y ,Z , NOFSET ,LPP , BEAM .DRAFT . LCF , 

1  VCG,GM,DELGM,NEBLA,KPITCH,KROLL,KYAW,KYAWRL,AWP.VCB,FBDX,FBDY, 

2  FBDZ , NFREBD , XPT , YPT , ZPT , NPTS , LCB , GML , ASTAT , BSTAT , TITLE , M ASS , 

2  DISPLH , IPITCH , IROLL , lYAW , lYAWRL ,CHEAVE , CPITCH, CHEAPI , CROLL , 

2  AREAMX ,WSURF .GIRTH ,FBDZV,DBLWL,TLCB 

INTEGER  NSTATN ,N0FSET(26) , NFREBD, NPTS 
CHARACTER+4  TITLE(20) 

REAL  X(25) ,Yd0,2B) ,2(10,25) .FBDZV(8,10) ,LPP,BEAH,DBLWL,TLCB , 

2  DRAFT . LCF , VCG , GM, DELGM , NEBLA .KPITCH .KROLL.KYAW , KY AHRL , AWP , VCB , 

2  FBDXdO),FBDYdO)  .FBDZdO)  .XPTdO)  ,YPTdO)  .ZPTClO)  , LCB. GML, 

4  ASTAT (26 ) , BSTAT (26 ) , MASS .DISPLM , IPITCH , IROLL , I Y AW , 

6  I YAWRL , CHEAVE , CPITCH .CHEAPI , CROLL , AREAMX , WSURF . GIRTH ( 26) 

COMMON  /lO/  SYSFIL,POTFIL,CQFFIL,LCOFIL,ICARD,TEXFIL.IPBIN, 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL , POTFIL , COFFIL .LCOFIL , ICARD , TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL . LRAFIL . ORGFIL . RAOFIL , RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /PHYSCO/  II , TP I , P I . PIOT , DEGRAD . R ADDEG . VKHETR . HETRVK , GEAV . 
2  RHO . GNU . RHOS , RHOF . GNUS . GNUF . FTMETR . PUN ITS . REYSCL 
COMPLEX  II 

CHARACTER*4  PUNITS(2) 

REAL  TP I , P I . PIOT . DEGRAD . RADDEG . VKMETR . METRVK , GRAY . RHO . GNU , RHOS . 

1  RHOF. GNUS, GNUF.  FTMETR 

COMMON  /RESPN/  NRESP  .IP0INTd82)  .IM0TN(182)  .ITYPEd82)  , 

2  1L1N(182)  ,ISYMd82) 

LOGICAL  ILIN.ISYM 

COMMON  /STATE/  LAT.VRT. LOADS. ADDRES, SALT, HEAD, EXROLL. BKEEL 
LOGICAL  LAT , VRT , LOADS , ADDRES , SALT , HEAD , EXROLL , BKEEL 

COMPLEX  MOTV(3,3O),MOTL(3,3O,8),HJV(3,30),HJL(3,3O),E7(3O) 
COMPLEX  SF3(25,30),SH3(26.30) 

DIMENSION  SA33 (26 , 30 ) . SB33 (26 , 30 ) 

DIMENSION  OMEGAEOO) ,RAQ1(30,8) ,PHS1(30,8) ,RA02(30,8) ,PHS2(30,8) 
LOGICAL  LINEAR. SYMHET 

DATA  EPS  /.OOl/ 

NMOT  =  3 

IP  =  IPOINT(IR) 

IM  =  IMOTN(IR) 

IT  =  ITyPE(IR) 

I.THF.AR  =  ILIN(IR) 

SYMMET  =  ISYM(IR) 
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N  =  1 

IF  (.NOT,  LINEAR)  N  =  NRANG 
HDNG  =  MU(IH.1V)»RADDEG 
ARG  =  HDMG+DEGRAD 
COSMU  =  COS(ARG) 

SINMU  =  SINCARG) 

READ  (ORGFIL)  VKNOTS .HEADHG , OMEGAE 
IF  (VRT)  READ  (ORGFIL)  MOTV 
IF  (LAT)  READ  (ORGFIL)  MOTL 
IF  (ADDRES)  READ  (ORGFIL)  HJV.HJL.H? 

IREC  =  1 

IF  ((AES(HEADNG) .LT.EPS  .OR.  ABS(HEADNG-180. ) .LT.EPS)  .AND. 

2  (.NOT. LINEAR)  .AND.  SYMMET)  IREC  =  0 

IF  ((ABS(HEADNG) .GT.EPS  .AND.  ABS(HEADNa-180. ) .GT.EPS)  .AND. 

2  (.NOT. SYMMET))  IREC  =  2 
IF  (IREC.EQ.O)  GO  TO  100 
Ml  =  1 
M2  =  NOMEGA 
DO  30  IA=1,N 

IF  (IP.EQ.O  .AND.  IM.LT.7)  CALL  ORAO  (IM , Ml ,H2 .MOTV , MDTL(l , 1 , lA) . 
2  RAOl ( 1 , lA) .PHSl ( 1 , lA) , NHOT , NOMEGA .RADDEG , IPHS) 

IF  (IP.GT.O  .AND.  IM.LT.4)  CALL  PRAO  (IM .Ml ,M2 ,MOTV , MOTL( 1 , 1 . lA) , 
2  XPT(IP) .YPT(IP) .ZPT(IP) , RAOl ( 1. lA). PHSl (l.IA) .RA02(l ,IA) . 

2  PHS2(1.IA) .NMOT.  IREC. NOMEGA, RADDEG. IPHS, OMEGAE, GRAY) 

IF  (IP.GT.O  .AND.  IM.EQ.IB)  CALL  PRA0(IM,M1 ,M2 ,MQTV ,MOTL( 1 . 1 , lA) , 
2  XPT(IP) ,YPT(IP) .ZPT(IP) ,RA01(1.IA).PHS1(1,1A),RA02(1,IA) , 

2  PHS2(1.IA)  .NMOT,  IREC . NOMEGA , RADDEG . IPHS . OMEGAE. GRAY) 

IF  (IM  .EQ.  8)  CALL  RELMOT  (IM .Ml .H2 .MOTV , 

2  M0TL(1.1,IA) ,FBDX(1P) , FBDY(IP) ,RA01(1 ,IA) , PHSl ( 1 , lA) .RA02(1.IA) , 

2  PHS2(1.IA) .NMOT,  IREC . NOMEGA .OMEGA, COSMU .SINMU , GRAY , RADDEG , IPHS) 
IF  (IP.EQ.O  .AND.  IH.Eq.9)  CALL  FNRAO  (IV , Ml . M2 .MOTT.( 1 , 1 , lA) , 

2  RAOKl.IA)  ,PHS1(1  ,IA)  ,  NMOT ,  NOMEGA  .OMEGAE,  IPHS) 

IF  (IT  .GT.  1)  CALL  VELACC  (IM , IT , GRAY, Ml .M2 , OMEGAE , 

2  RAOKl.IA)  .PHSKl.IA)  .RA02(1,IA),PHS2(1,1A)  .NOMEGA, IREC, IPHS) 

IF  (IH  .EQ.  7)  CALL  ADRES  (Ml ,M2,M0TV ,M0TL(1 . 1 ,IA) ,H JV ,HJL,H7 , 

2  RAOl (l.IA), PHSl (1,IA).RA02(1,IA),PHS2(1,IA), OMEGA, NMOT, IREC, 

2  NOMEG A. RADDEG, COSMU, RHO. IPHS) 

30  CONTINUE 

IF  (.NOT.  (IP.GT.O  .AND.  (IM.GE.10.AND.IM.LE.14)))  GO  TO  100 
DO  40  IW=1, NOMEGA 

READ  (LCOFIL)  (SF3(I,IW) ,SH3(I,IW) ,SA33(I,IW).SB33(I,IU) , 

2  I=1,NSTATN) 

40  CONTINUE 

CALL  LRAO  (IM, Ml, M2. MOTV, SF3, SH3, SA33, SB33, VFS(IV) , COSMU, 

2  OMEGA , OMEGAE , IP ,RAO 1 , PHS 1 , NMOT , NOMEGA , IPHS ) 

100  CONTINUE 

RETURN 

END 

C  DECK  RDBASE 

SUBROUTINE  RDBASE 

COMMON  /CH3D/  ISIGMA,SIGMIN,SIGMAX,V, SINMU, COSMU, WTSI, 

2  IMMIN.IMMAX.IMDEL.LMIN.LHAX 

REAL  SIGMIN.SIGMAX.V, SINMU. COSMU, WTSI(4) 

INTEGER  ISIGHA , IMMIN , IMMAX , IHDEL ,LMIN , LMAX 

COMMON  /DATIHP/  OPTH ,MOTN ,BSCF1L,VLACPR,RA0PR,RLDMPR.DISPLMT, 

2  LRAOPR, ADRPR.ORGOPTN .GMNOH .KG .STATN(25) ,KS0FST(2B) , 

2  NLEWF( 26 ) , HLFBTH ( 1 0 , 26 ) , WTRLNE ( 1 0 . 26 ) , BLEWF ( 26 ) . TLEUF ( 26 ) . 

2  AREALF ( 26 ) , NPTLOC , PTKUMB ( 1 0 ) . PTN  AME . XPTLOC ( 10 ) , YPTLOC ( 1 0 ) , 

2  ZPTLOC ( 10 ) , NBB , FBNUMB ( 1 0 ) , FBN AME , XPTFBD (10), YPTFBD (10), 

2  2PTFBD ( 10 ) .FBCODEC 10 ) , FBTY PE , RDOT ( 10 ) , VKDES , FHDES . 

2  STATNM.STATIS 

CHARACTER*4  PTHAKE(8 . 10) .FBNAME(8 ,10) ,STATNM(6) ,FBTYPE(3 , 10) 
INTEGER  OPTN . MOTH , BSCFIL , VLACPR , RAOPR , ADRPR , RLDMPR , FBCODE , 

2  FBNUMB, PTNUMB.QRGOPTN 
REAL  KG 

COMMON  /ENVIOR/  VK.NVK, MU, NMU, OMEGA, NOMEGA. SIGMA, NSIGMA.SIGWH, 

1  ISlGWa , TnuDAL , HTKOD , KRAKG , RANG , RLAKG , S , SKKU , FRKUM , VFS 
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INTEGER  NVK.NHU.N0HEGA,NSIGMA,NSIGWH,NTM0D,NRANG,NNMU(8) 

REAL  VK(8) .MU(37,8) .QHEGAOO) .SIGMA(IO) ,SIGWH(4) ,THQDAL(8) , 

2  RANG(8) ,RLANG(8) ,S(30,8) ,FRNUM(8) ,VFS(8) 

COMMON  /GEOM/  X,NSTATN,Y.Z,NOFSET,LPP, BEAM, DRAFT, LCF, 

1  VCG , GM , DELGM , NEBLA . KPITCH .KROLL , KY AW .KY AWRL , AWP , VCB , FBDX , FBDY . 

2  FBD2 , NFREBD , XPT , YPT . ZPT , NPTS , LCB , GML . ASTAT . BSTAT , TITLE , MASS , 

2  DISPLM , IPITCH , IROLL , lYAW , I YAWKL , CHEAVE , CPITCH , CHEAPI , CROLL , 

2  AREAMX . WSURF .GIRTH , FBDZV.DBLWL ,TLCB 

INTEGER  NSTATN,H0FSET(25) , NFREBD, NPTS 
CHARACTER+4  TITLE(20) 

REAL  X(25) ,Y(10,25) ,Z(10 ,25) .FBDZV(8 , 10) .LPP .BEAM .DBLWL . TLCB , 

2  DRAFT , LCF . VCG , GM, DELGM .NEBLA , KPITCH , KROLL, KYAW , KYAWRL , AWP , VCB , 

2  FBDX(10),FBDY(10) ,FBDZ(10) ,XPT(10) .YPT(IO) .ZPT(IO) , LCB, GML, 

4  ASTAT(25) , BSTAT(25) .MASS , DISPLM , IPITCH , IROLL , lYAW , 

6  lY AWRL , CHEAVE , CPITCH . CHEAPI , CROLL , AREAMX , WSURF , GIRTH ( 25 ) 

COMMON  /lO/  SYSFIL,POTFIL,COFFIL,LCOFIL,ICARD.TEXFIL,IPRIN, 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL . SEVFIL , SPDFIL . 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL , POTFIL , COFFIL .LCOFIL , ICARD .TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL . RAOFIL , RMSFIL . SEVFIL . SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /PHYSCO/  II .TPI .PI .PIOT, DEGRAD .RADDEG .VKMETR .METRVK , GRAY , 

2  RHO , GNU ,RHOS ,RHOF .GNUS ,GNUF .FTMETR.PUNITS.REYSCL 
COMPLEX  II 

CHARACTER*4  PUNITS(2) 

REAL  TPI , PI . PIOT . DEGRAD , RADDEG . VKMETR . METRVK , GRAV . RHO . GNU , RHOS , 

1  RHQF.GNUS.GNUF.FTMETR 

COMMON  /RLDBK/  PSUR(25) .BMK(25) ,DK(25) ,CAK(25) .HQ .HSPAN .HMNCHD , 

2  HAREA,HXCP,HYCP.HZCP,HGAMMA,HYHAT,HEAR.HLCS.RQ(2) ,RSPAN(2), 

2  RMNCUD(2) .RAREA(2) .RXCP(2) ,RYCP(2) ,RZCP(2) .RGAMMA(2) ,RYHAT(2) , 

2  REAR(2) .RLCS(2),SQ(2),SSPAN(2),SMNCHD(2),SAREA(2),SXCP(2) , 

2  SYCP(2),SZCP(2),SGAMMA(,2),SYHAT(2),SEAK(2),SLC5(2),BQ(2) , 

2  BSPAN(2) ,BMNCHD(2) ,RAREA(2) .BXCP(2) .BYCP(2) ,BZCP(2) ,BGAMMA(2) , 

2  BYHAT(2) ,BEAR(2) ,BLCS(2) ,FQ(2) ,FSPAN(2) ,FMNCHD(2) ,FAREA(2) , 

2  FXCP(2) ,FYCP(2) ,FZCP(2) ,FGAMHA(2) ,FYHAT(2) ,FEAR(2),FLCS(2) . 

2  PC!(2,2) .PSPAN(2.2) ,PMNCHD(2,2).PAREA(2,2),PXCP(2,2),PYCP(2,2) , 

2  PZCP(2,2),PGAMMA(2,2).PYHAT(2.2).PEAR(2,2) ,PLCS(2,2) , 

2  STADMP(IO) .SHPDMPdO ,8) .ENCON ,WPHI ,TPHI ,WMELM(4 ,9) ,SFELM(4 .9,8), 

2  REELM(4,9,8),PEELM(4,9,8),FEELM(4,9,B),HEELM(4,9,8),BEELM(4,9,8). 
2  ENWM,ENSF(8.8) ,ENRE(8) ,ENPE(8) ,ENFE(8) ,ENHE(8) ,ENBE(8) , 

2  ENEMV(8,8) ,ENRL(8) ,ENPLC8) ,ENFL(8) ,ENHL(8) ,ENSL(8) ,ENBL(8) , 

2  ENSHP(8,8) ,RELH(4.9) .ITS(25) ,RD(26) ,EDDY(B,25) ,RGB(25) 

REAL  RDBLK(2S92) 

EQUIVALENCE  (PSUR(l) ,RDBLK(1)) 

COMMON  /SMPSYS/  FIS , AS , SIS .SOS ,SDS .HALOS , DEV ,PRN , SMPPS .SHPIS , 

2  SMPOS , SMPDS . SHPTYPS .SHIPS , VARS , CYCLS .TITLES , OPTION . LS IS , LSOS , 

2  LSDS , LHALOS , LDEV . LPRN . LSMPPS . LSMPIS .LSHPOS . LSHPDS .LSHPTYP3 , 

2  LSHIPS.LTITLES 
CHARACTER* 160  AS 

CHARACTER»80  FIS , SIS , SOS . SDS .TITLES 

CH ARACTER*20  HALOS , DEV , PRN , SMPPS . SHPIS . SMPOS , SMPDS .SHPTYPS 
CHARACTER  SHIPS*6 .VARS*2.CYCLS*2 
INTEGER*2  OPTION 
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DO  30  K=1,NSTATN 
IF  (HOFSET(K)  .LT.  2)  GO  TO  30 
NHODES  =  NOFSET(K) 

NSEGS  =  NNODES  -  1 
SGIRTH  =  0. 

DO  10  J=l. NSEGS 

SGIRTH  =  SGIRTH  +  SQRTC (Y( J+1 ,K)-y( J ,K) )**2  +  (Z(J+1.K) 
-Z(J,K))**2) 

CONTINUE 


(K  .EQ.  1)  DS  =  0.6*(X(2)-X(1)) 

(K  GT.I  .AND.  K.LT.NSTATN)  DS  =  0 . 5*(X(K+i )-X(K-l) ) 
•EQ.  NSTATN)  DS  =  0.6*(X(KSTATN)-XCHSTATN-l)) 


IF 

TV 

IF  (K 

PSUR(K)  =  2.*DS*SGIRTH 
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*  ♦ 


BMK(K)  =  BMAX(NN0DES,Y(1,K)) 

DK(K)  =  0. 

DO  20  J=1,NB0DES 

IF  (Z(J,K)  .LT.  DK(K))  DK(K)  =  Z(J,K) 

20  CONTINUE 

CAK(K)  =  ASTAT(K)/(2+BMK(K)*ABS(DK(K))) 

30  CONTINUE 
CALL  VAVHAK 
CALL  HLLIFT 
CALL  RDLIFT 
CALL  SBLIFT 
CALL  SKLIFT 
CALL  BKLIFT 
CALL  FNLIFT 
CALL  SKNFRC 
CALL  RDEDDY 
CALL  SBEDDY 
CALL  FNEDDY 
CALL  HLEDDY 
DO  SO  IA=1,NRANG 

ENEMO  =  EHHE(IA)  +  ENRE(IA)  +  ENPE(IA)  +  ENFE(IA) 

DO  40  IV=1,NVK 
V  =  VFS(IV) 

ENEMV(IV,IA)  =  EDMKSP(WPHI,LPP,V. ENEMO) 

40  CONTINUE 
SO  CONTINUE 
CALL  BKEDDY 
DO  60  IA=1,NRANG 
DO  60  IV=1,NVK 

EtlSHP(IV.IA)  =  ENWM  +  ENHL(IV)  +  ENRL(IV)  +  ENPL(IV)  +  ENSL(IV)  + 
2  ENBL(IV)  +  ENFL(IV)  +  ENSF(IV,IA)  +  ENEHV(IV,IA)  +  ENBE(IA) 

60  CONTINUE 

IF  (RLDMPR  .GT.  0)  CALL  RDPRIN 


FIS  =  SDS(1 :LSDS)//> .SCR’ 

OPEN  (UNIT=SCRFIL ,FILE=FIS .FORM® 'UNFORMATTED ' ,STATUS= 'UNKNOWN ’ ) 
WRITE  (SCRFIL)  RDBLK 
CLOSE  (UN1T=SCRFIL) 

RETURN 

END 

C  DECK  RDCOMP 

SUBROUTINE  RDCOMP  (N ,NDIM, A,IP) 


*  matrix  triangularization  by  gaussieai  elimination. 

*  INPUT... 

*  N  =  order  of  matrix. 

*  NDIM  =  declared  dimension  of  array  A  . 

*  A  =  matrix  to  be  triau(^ularizeu. 

*  OUTPUT . . . 

*  A(I,J),  I  .LE.  J  =  upper  triauigular  factor,  U  . 

*  A(I,J),1.GT.J=  multipliers  =  lover  triangular 

*  factor,  I  -  L  . 

*  IP(K),  K  .LT.  I  =  index  of  k-th  pivot  rov. 

*  IP(N)  =  (-l)**(number  of  interchanges)  or  0  . 

*  use  "solve"  to  obtain  solution  of  linear  system. 

DETERM(  A  )  =  IP(H)*A( 1 ,1)*A(2 ,2)* . . .♦ACN ,H) . 

IF  IP(H)  =  0,  A  is  singul2u:,  SOLVE  will  divide  by  zero. 

*  interchanges  finished  in  u,  only  partialy  in  1  . 

REAL  A,  T,  ABS 

INTEGER  N,  NDIM,  IP,  K,  KPl,  M,  I,  J 
DIMENSION  A(ND1H,KDIK) 

DIKEN3I0N  IF(KDIM} 

IP(H)  =  1 


109 


DO  1700  K  =  1,  N 
IF  (K  .EQ.  H)  GO  TO  1600 
KPl  =  K  +  1 
M  =  K 

DO  1100  1  =  KPl.  N 

IF  (ABS(A(1,K))  .GT.  ABS(A(M,K)))  M  =  I 
1100  CONTINUE 
IP(K)  =  H 

IF  (M  .NE.  K)  IP(N)  =  -IP(N) 

T  =  A(M.K) 

A(M.K)  =  A(K,K) 

A(K  K)  =  T 

IF  (t  .EQ.  0.0)  GO  TO  1600 
DO  1200  I  =  KPl,  N 
A(I,K)  =  -A(I,K)/T 
1200  CONTINUE 

DO  1500  J  =  KPl,  N 
T  =  A(M,J) 

A(M,J)  =  A(K,J) 

A(K,J)  =  T 

IF  (  T  .EQ.  0.0  )  GO  TO  1400 
DO  1300  I  =  KPl,  N 
A(I.J)  =  A(I,J)  +  A(I.K)*T 
1300  CONTINUE 
1400  CONTINUE 
1500  CONTINUE 
1600  CONTINUE 

IF  (A(K.K)  .EQ.  0.0)  IP(N)  =  0 
1700  CONTINUE 
99999  CONTINUE 


RETURN 

END 


C  DECK  RDEDDY 

SUBROUTINE  RDEDDY 


COMMON  /APPEND/  NBKSET,NBKSTN(2) ,BKIMAG(2) ,BKFS(2) ,BKAS(2) , 
BKWD(2) ,BKSTN(10,2) ,BKHB(10 .2) .BKLNTH.BKWDTH , 

BKWL( 10,2) ,BKAK (10,2) . NSKSET , SKIMAGC  2 ) , SKFLS (2 ) , SKALS ( 2) , 

SKAUS(2) ,SKHB(2),SKFLHL(2) ,SKALWL(2) ,SKAUWL(2) ,NRDSET,PDIMAG(2) , 
RDRFS ( 2 ) , RDRAS ( 2) , RDRHB ( 2 ) , RDRFWL ( 2K  RDRA WL ( 2^  RDTFS (2), RDTAS ( 2 ) , 
RDTHB(2),RDIFML(2),RDTAHI,(2),NSBSET,SBIMAG(2),S0BRFS(2),S0BRAS(2) 
2.SQBRHB(2) ,S0BRFW(2) ,S0BRAW(2) ,SIBRFS(2) ,SIBRAS(2) ,SIBRHB(2) , 

2  SIBRFU(2) ,SIBRAW(2) ,SBTFS(2) ,SBTAS(2) .SBTHB(2) ,SBTFWL(2) , 

2  SBTAWL(2) ,KFNSET.FNIMAG(2) ,FNRFS(2) ,FNRAS(2) , 

2  FHRHB(2) ,FNRFWL(2) ,FNRAHL(2) ,FNTFS(2) ,FNTAS(2) .FHTHB(2) . 

2  FK rFWL(2 ) , FKTAWL(2 ) , NEXPRD , ENROO (8 ) , EHRDS (8 ) 


COMMON  /CH3v/  TSIGMA.SIGMIN.SIGMAX.V.SINMU.COSMU.WTSI, 
2  IMMIH,IHMAX,IriDEL,LMIN,LKAX 

REAL  SIGKIR,SIGMAX,V,SIKHU,C0SMU,WTSI(4) 

INTEGER  ISIGHA , IMMIN , IMHAX . IHDEL ,LHIN , LHAX 


COMMON  /ENVIOR/  VK.NVK, MU, NMU, OMEGA. NOMEGA, SIGMA, NSIGHA.SIGWH, 

1  NSIGWH , TMODAL , NTMOD . NRANG .RANG . RLAHG .S , HNMU , FRNUM , VFS 
INTEGER  NVK , NMU , NOMEGA , NSIGMA .NSIGWH , NTMOD . NRANG . NNMU (8 ) 

REAL  VK(8) .MU(37,8) ,OMEGA(30) ,SIGMA(10) ,SIGWH(4) .TM0DAL(8) , 

2  RANG(8) .RLANGCB) ,S(30,8) ,FRNUM(8) ,VFS(8) 


COMMON  /PHYSCO/  II ,TPI , PI ,PIOT, DEGRAD, RADDEG .VKMETR.METRVK, GRAY, 
2  RHO , GNU , RHOS , RHOF , GNUS , GNUF , FTMETR.PUNITS , REYSCL 
COMPLEX  II 

CHARACTER.*4  PUKITS(2) 

REAL  TPI , PI , P lOT , DEGRAD . RADDEG . VKMETR , METRVK . GRAY , RHO , GNU , RHOS , 
i  RHOF, GNUS, GNUF, FTMETR 


COMMON  /RLDBK/  PSUR(26) ,BMK(26) .DK(25) ,CAK(25) .HQ .HSPAN .HMNCHD . 
2  HAREA,HXCP.HYCP.EZCP,HGAMMA.HYHAT,HEAR,HLCS,RQ(2) ,RSPAN(2) , 

2  RMNCHD(2) ,RAREA(2) ,RXCP(2) ,RYCP(2) ,RZCP(2) ,RGAMMA(2) .RYHAT(2) , 

2  REAK(2) ,RLCS(2),5Q(2),S5FAK(2),3KKCI;D(2),SAREA(2),SXCP(2) , 

2  SYCP(2),S2CPC2).SGAHKA(2),SYUAT(2),SEAR(2).SLCSC2).BQ(2) , 
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C  DECK 
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BSPAH(;2) ,BMNCHD(2) ,BAREA(2) ,BXCP(2) ,BYCP(2) ,BZCP(2) ,BGAMMA(2) , 
BYHATU) .BEAR(2) ,BLCS(2) .FQ(2) ,FSPAN(2) ,FHNCHD(2) .FAREA(2) , 
FXCP(2) ,FYCP(2) .FZCP(2) ,FGAMMA(2) ,FYKAT(2) .FEAR(2) ,FLCS(2) , 
Pq(2,2) .PSPANCZ.Z) ,PMNCHD(2,2) ,PAREA(2,2),PXCP(2,2),PYCP(2,2)  , 
PZCP(2.2),PGAMMA(2,2),PYHAT(2,2),PEAR(2,2) ,PLCS(2.2) , 

STADMP(IO) ,SHPDMP(10,8),ENCQN,WPHI,TPHI.VJMELM(4.9),SFELM(4,9,8), 
REELM(4,9,8).PEELM(4,9.8),FEELM(4,9,8).HEELM(4,9.8) ,BEELM(4,9,8) , 
ENWM,ENSF(8,8) ,ENRE(8) .ENPE(8) ,EKFE{8) .ENHE(8) ,ENBE(8) , 

ENEMY (8. 8) .ENRL(8) ,ENPL(8) , ENFL(8) ,ENHL(8 ) . ENSL(8 ) ,ENBL(8) , 
ENSHP(8,8) ,RELM(4,9) .ITS (25) ,RD (25) ,EDDY(8 , 2S) ,RGB(25) 

REAL  RDBLK(2692) 

EQUIVALENCE  (PSUR(l)  ,RDBU(l)) 

DO  20  IA=1,NRAHG 
EHRE(IA)  =  0 
DO  10  IS=1.HSIGMa 
SHPDMPdS.IA)  =  0 
CONTINUE 
CONTINUE 

IF  (NRDSET  .EQ.  0)  GO  TO  100 
DO  50  K=1  NRDSET 

YHAT  =  SQRT(RYCP(K)*RYCP(K)  +  R2CP(K)*RZCP(K) ) 

GAMMAE  =  RGAMMA(K)  +  1. 

ALF  =  ATAN(  ABS(  ( (RYCP (K) /RZCP (K) )  +  TAN(GAMMAE*DEGRAD) )/(l .  - 
(RYCP(K)/RZCP(K))*TAN(GAMMAE*DEGRAD))  )  ) 

C  =  0,0065  +  (RLCS(K)*RLCS(K))/(0.9*PI*REAR(K)) 

CON  =  RQ(K)*4./(3.*PI)*RH0*YHAT**3*RAREA(K)*C+SIN(ALF) 

DO  40  1A=1,NRANG 
DO  30  IS=1,NSIGMA 

SHPDMPdS.IA)  =  SHPDMPdS.IA)  +  (CON*SIGMAdS)*RANGdA) )  * 
SIGMAdS) 

CONTINUE 
CONTINUE 
CONTINUE 
DO  60  IA-1,NRANG 

CALL  SPFIT  (SIGMA. SHPDHP(1,IA).REELM(1.1,IA),NSIGMA) 

ENRE(IA)  =  ENCQN*REVAL(REELM(1.ISIGMA,IA).VITS1) 

CONTINUE 

CONTINUE 

RETURN 

END 

RDEVAL 

SUBROUTINE  RDEVAL  (IV, OMEGA, OMEGAE.NRANG.TLG.EXCLG.TLGC.EXCLGC, 
T44T) 

COMMON  /APPEND/  NBKSET.NBKSTN(2) ,BKIHAG{2) ,BKFS(2) ,BKAS(2) . 

BKWD ( 2 ) , BK3TN ( 1 0 , 2 ) , BKHB ( 10 , 2 ) , BKLNTH , BKUDTH , 
BKWL(10,2),BKAK(10,2).NSKSET,SKIMAG(2).SKFLS(2) ,SKALS(2) , 

SKAUS(2) ,SKHB(2),SKFLWL(2),SKALWL(2),SKAUWL(2). NRDSET, RDIMAG(2), 
RDRFS(2) ,RDRAS(2) ,RDRHB(2) .RDRFl<L(2) .RDrUWL(2) ,RDTFS(2) .RDTAS(2), 
RDTHB(2),RDTFtfL(2),RDTAWL(2),HSBSET,SBIMAC(2),S0BRFS(,2) ,50BRAS(2) 
,S0BRHB(2) ,S0BRFW(2) ,S0BRAW(2) ,SIBRFS(2) ,SIBRAS(2) ,SIBRHB(2) , 
SIBRFW(2) ,SIBRAW(2) ,SBTFS(2) ,SBTAS(2) ,SBTHB(2) ,SBTFWL(2) , 
SBTAWL(2) .NFNSET,FHIMAG(2),FNRFS(2),FNRAS(2) , 

FNRHB(2) ,FNRFUL{2) ,FNRAWL(2) ,FNTFS(2) ,FNTAS(2) ,FNTHB(2) , 

FNTFWL(2) ,FNTAWL(2) ,MEXPRD.ENRrO(8) ,EBRDS(8) 

COMMON  /CH3D/  ISIGMA.SIGMIN.SIGMAX.V.SINMU.COSMU.WTSI, 

IMMIN . IMMAX , IMDEL , LMIN ,LMAX 

REAL  SIGHIH,SIGMAX,V,SINMU,C0SMU,WTSI(4) 

INTEGER  ISIGMA . IMHIN , IMMAX , IMDEL .LMIN , LMAX 

COMMON  /GEOM/  X.NSTATH.Y.Z.NOFSET.LPP. BEAM, DRAFT, LCF, 

VCG , GH .DELGM .NEBLA .KPITCH .KROLL .KYAW .KYAWRL , AWP , VCB , FBDX , FBDY , 
FBDZ . NFREBD , XPT , YPT . ZPT . NPTS , LC3 ,GML , ASTAT . BSTAT .TITLE , MASS . 
DISPLM , IPITCH , TROLL . lYAW , lYAWRL , CKEAVE , CPITCH , CHEAP I , CROLL . 

ARE AMX , WSURF , GIRTH , FBDZ V , DBLWL , TLCB 
INTEGER  NSTATN,N0FSET(2B) .NFREBD.NPTS 
C5ARACTERi4  TITLE(20) 

REAL  X(26) ,Y(10,26) ,Z(10,26) ,FBDZV(8, 10), LPP, BEAM, DBLUL, TLCB, 
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2  DRAFT . LCF , VCG , GM , DELGM , NEBLA . KPITCH , KRDLL , K Y AW , KY AWRL , AWP . VCB , 

2  FBDX(10),FBDY(10) .FEDZ(lO) ,XPT( 10) , YPT( 10 ) , ZPTC 10 ) .LCB.GML, 

4  ASTAT(25) ,BSTAT(25) , MASS .DISPLM , IPITCH . IROLL , lYAW , 

5  lYAWRL , CHEAVE , CPITCH .CHEAP! , CROLL . AREAMX . WSURF , GIRTH ( 25 ) 

COMMON  /PHYSCO/  II ,TPI , PI ,P10T, DEGRAD .RADDEG .VKMETR.METRVK , GRAV . 
2  RHO , GNU , RHOS , RHOF , GNUS , GNUF .FTMETR .PUNITS , REYSCL 
COMPLEX  II 

CHARACTER*4  PUNITS(2) 

REAL  TPI . PI . PIOT, DEGRAD . RADDEG .VKMETR .METRVK . GRAV . RHO , GNU , RHOS , 

1  RHOF, GNUS, GNUF. FTMETR 

COMMON  /RLDBK/  PSUR(25) .BMK(25) .DK(2S) .CAK(25) , HQ , HSPAN , HMNCHD , 

2  HAREA,HXCP,HYCP,H2CP.HGAMMA,HYHAT,HEAR,HLCS.RQ(2) ,RSPAN(2) , 

2  RMNCHD(2) .RAREA(2) .RXCP(2) ,RYCP(2) ,RZCP (2) , RGAMMA C2) ,RYHAT(2) , 

2  REAR(2) ,RLCS(2) .SQ(2) ,SSPAN(2) ,SMNCHD(2) ,SAREA(2) ,SXCP(2) , 

2  SYCP(2) ,S2CP(2) ,SGAMHA(2) ,SYHAT(2) ,SEAR(2) , SLCS (2) ,BQ (2) , 

2  BSPAN(;2) ,BHNCHD(2) ,BAREA(2) ,BXCP(2) . BYCP(2 ) , BZCP (2) , BGAMMA (2 ) , 

2  BYHAT(2)  ,BEAR(2) , BLCS(2) ,FQ(2) .FSPAN(2) .FMNCHD(2) ,FAREA(2) . 

2  FXCP(2) .FYCP(2) .FZCP(2) .FGAMHA(2) .FYHAT(2) ,FEAR(2) ,FLCS(2) , 

2  PQ(2,2) ,PSPAN(2.2) .PMNCHD(2 . 2) ,PAREA(2 , 2) ,PXCP (2 , 2) , PYCP (2 , 2) , 

2  P2CP(2.2),PGAMMA(2,2) .PYHAT(2 .2) , PEAR(2 .2) , PLCS (2 , 2 5 , 

2  STADMP(IO) .SHPDMPdO.B) .ENCON ,WPHI ,TPHI .WMELM(4 ,9) ,SFELM(4 ,9 ,8) , 
2  REELM(4,9.8) . PEELM (4 .9 , 8 ) .FEELH(4 , 9 , 8) , HEELM (4 , 9 , 8 ) . BEELM(4 , 9 , 8 ) 
2  ENWH.ENSF(8,8) .ENRE(8) ,ENPE(8) ,ENFE(e) .ENHE(8) , ENBE(8 ) . 

2  ENEMV(;8.8).ENRL(8) ,ENPL(8) ,ENFL(8) ,ENHL(8) . ENSL( 8) , ENBL(8) , 

2  ENSHP(8,8) .RELM(4,9) ,ITS(2E) , RD(25) , EDDY (8 , 2E) , RGB (25 ) 

REAL  RDBLK(2692) 

EQUIVALENCE  (PSUR( 1 ) , RDBLK(1 ) ) 

COMMON  /FINCQN/  IACTFH.IFCLCS,FGAIN(8) ,FKC3) .FA(3) ,FB(3) , 

2  FCLCS(8,2) 

COMPLEX  TLG(3,3) ,EXCLG(3) ,TLGC(3,3) ,EXCLGC(3) 

DIMENSION  T44T(NRAHG) 


*  TLG  =  LHS  containing  Havemaking  datiiuing  only 

*  EXCLG  =  RHS 

*  TLGC  and  EXCLGC  are  LHS  and  RHS  corrected  by  oppeiidage  and  hull 

*  damping 

*  T44  =  WE+B44  (imaginary  part  oi  TLG  axT&y) 

*  B44  =  roll  damping  moment 

*  N  (roll  decay  coefficient)  =  B44'»WE/(2*C44) 

*  C44  =  DISPLACEHENT*GM 

e  B44  (TOTAL)  =  B44WM  + 

*  B44HL  +  B44RL  +  B44PL  +  B44SL  +  B44BL  +  B44FL  + 

*  B44SFV  +  B44EHV  +  B44BE 

*  Wavemn)cing  damping  -  B44WM  =  AIMAG(TLG(2,2) )/WE 

*  hull  lift  damping 

CALL  LSCOF  (OMEGA, OMEGAE.O, HSPAN, HMNCHD, HAREA.HLCS.HGAMHA, 

2  HXCP , HYCP , H2CP , TLG .EXCLG .TLGC .EXCLGC ) 

*  rudder  lift  damping 

IF  (NRDSET  .EQ.  0)  GO  TO  16 
DO  10  K=l. NRDSET 

CALL  LSCOF  (OMEGA ,0MEGAE,2 ,RSPAN(K) ,RHNCHD(K) ,RAREA(K) ,RLCS(K) , 
2  RGAMMA (K ), RXCP (K ), RYCP ( K ), RZCP (K ). TLGC , EXCLGC , TLGC , EXCLGC ) 

ANGLE  =  180.  “  RGAMMA(K) 

IF  (RDIMAG(K)  .GT.  1.) 

2  CALL  LSCOF  (OMEGA .OHEGAE ,2,RSPAN(K) ,RMNCHD(K) ,RAREA(K) ,RLCS(K) , 
2  ANGLE , RXCP (K) , -RYCP(K) , RZCP (K) ,TLGC , EXCLGC , TLGC .EXCLGC) 

10  CONTINUE 
15  CONTINUE 

*  propeller  shaft  bracket  lift  damping 

IF  (NSBSET  -EQ.  0)  GO  TO  19 
DO  16  K=l, NSBSET 

^  T— 4  *** 

1>U  I't 

IF  (L.EQ.2  .AND.  SBTHB(K) .EQ.O. )  GO  TO  14 
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ANGLE  =  PGAMHA(K,L) 

IF  (ANGLE  .GT.  0.)  ANGLE  =  ANGLE  +  160. 

CALL  LSCOF  (OMEGA .0MEGAE,2 ,PSPAN (K.L) .PMNCKDCK ,L) ,PAREA (K ,L) , 

2  PLCS(K,L) .ANGLE, PXCP(K,L) ,PYCP(K,L),PZCP(K.L),TLGC,EXCLGC, 

2  TLGC.EXCLGC) 

ANGLE  =  -  PGAMMA(K,L) 

IF  (SBIMAG(K) .GT.l.  .AND.  ANGLE. GT.O.)  ANGLE  =  ANGLE  +  180. 

IF  (SBIMAG(K)  .GT.  1 . ) 

2  CALL  LSCOF  (OMEGA , OHEGAE , 2 .PSPAN (K .L) , PMNCHD(K ,L) .PAREA (K , L) , 

2  PLCS (K,L), ANGLE, PXCP (K.L) ,-PYCP(K,L).PZCP(K,L) ,TLGC, 

2  EXCLGC.TLGC.EXCLGC) 

14  CONTINUE 
16  CONTINUE 

19  CONTINUE 

*  skeg  lilt  damping 

IF  (NSKSET  .EQ.  0)  GO  TO  26 
DO  20  K=l. NSKSET 

CALL  LSCOF  (OMEGA , OMEGAE.O , SSPAN(K) , SMNCHD (K ), SAREA (K ), SLCS(K) . 
2  SGAMMA(K) .SXCP(K) ,SYCP(K) ,SZCP(K) ,TLGC .EXCLGC.TLGC .EXCLGC) 

ANGLE  =  180.  -  SGAMMA(K) 

IF  (SKIMAG(K)  .GT.  1.) 

2  CALL  LSCOF  (OMEGA , OMEGAE ,0 , SSPAN (K) , SMNCHD(K) , SAREA(K ), SLCS(K ) , 
2  ANGLE, SXCP(K) .-SYCP(K) .SZCP(K) ,TLGC .EXCLGC ,TLGC .EXCLGC ) 

20  CONTINUE 
25  CONTINUE 

*  bilgekeel  lilt  damping 

IF  (NBKSET  .EQ.  0)  GO  TO  35 
DO  30  K=l. NBKSET 

CALL  LSCOF  (OMEGA.OMEGAE, 1 ,BSPAN(K) ,BMNCHD(K) .BAREA (K) ,BLCS(K) , 
2  BGAMMA(K) ,BXCP(K) .BYCP(K) .BZCP(K) ,TLGC, EXCLGC.TLGC, EXCLGC) 

ANGLE  =  180.  -  BGAMMA(K) 

IF  (BKIMAG(K)  .GT.  1.) 

2  CALL  LSCOF  (OMEGA .OMEGAE , 1 .BSPAN(K) ,BMNCHP(K) .PARF.A (K) ,BLCS(K) . 
2  ANGLE, BXCP(K),-BYCP(K) ,BZCP(K) .TLGC, EXCLGC.TLGC, EXCLGC) 

30  CONTINUE 
35  CONTINUE 

*  lin  lilt  damping 

IF  (NFNSET  .EQ.  0)  GO  TO  45 
DO  40  K=l, NFNSET 
TEMP  =  FLCS(K) 

IF  (IFCLCS  .EQ.  1)  TEMP  =  FCLCS(1V,K) 

CALL  LSCOF  (OMEGA ,0MEGAE,2 .FSPAN (K) ,FMNCHD(K) ,FAR£A(K) .TEMP . 

2  FGAMHA(K) ,FXCP(K) ,FYCP(K) ,FZCP(K) .TLGC, EXCLGC, TLGC, EXCLGC) 
ANGLE  =  180.  -  FGAMMA(K) 

IF  (FNIHAG(K)  .GT.  1.) 

2  CALL  LSCOF  (OMEGA .OMEGAE, 2 .FSPAN(K) ,FKNCHD(K) .FAREA(K) .TEMP . 

2  ANGLE, FXCP(K) .-rVCP(K) .F2CP(K) .TLGC, EXCLGC, TL-GC, EXCLGC) 

40  CONTINUE 
46  CONTINUE 

DC  100  lA^l.NRANG 

*  skin  Iriction  damping  at  spssd 

T44SF  =  REVAL(SFELM(1,I3IGMA.IA) ,WTSI) 

T44SFV  =  SKFRSP  (OMEGAE, LPP,V,T44SF) 

■«'  raddar  sddy  damping 

T44RE  =  0 

IF  (NRDSET.GT.O)  T44RE  =  REVAL(REELH(l.ISIGMA.IA) ,WTSI) 


*  propeller  shalt  bracket  eddy  damping 
T44PE  =  0 

IF  (NSBSET.GT.O)  T44PE  =  REVAL(PEELM(1.ISIGMA,IA) .WTSI) 
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lin  eddy  dftinping 
T44FE  -  0 

IF  (NFKSET  .GT.  0)  T44FE  =  REVALCFEELMC 1 . ISIGMA , 1 A) . WTSl ) 


♦  hull  eddy  damping 

T44HE  REVALCHEELMd, ISIGMA, 1A).UTSI) 

♦  eddyraaking  at  speed 

T44EM  =  T44HE  +  T44RE  +  T44PE  +  T44FE 
T44EHV  =  EDMKSP  (OMEGAE ,LPP ,V ,T44EM) 

♦  bilgekeel  eddy  damping 

T44BE  =  0. 

IF  (KBKSET  .EQ.  0)  GO  TO  70 

T44BE  =  REVALCBEELMCl, ISIGMA. lA), WTSl) 

70  CONTINUE 

T44T(IA)  =  T44SFV  +  T44EMV  +  T44BE 
100  CONTINUE 

RETURN 

END 

C  DECK  RDLIFT 

SUBROUTINE  RDLIFT 

COMMON  /APPEND/  NBKSET , NBKSTN (2) ,BKIMAG(0) , BKFS(2) , BK AS (2 ) , 

2  BKWD(2) ,BKSTN(]0,2)  ,BKHB ( 10 . 2) . BKLNTH , BKWDTH . 

2  BKUL(10,2) ,BKAN(10,2),NSKSET.SKIHAG(2) .SKFLS(2) .SKALS(2) . 

2  SKAUSd)  ,SKHB(2),SKFLVL(2)  .SKALWLd)  ,SK  AUULd)  .  «1^DSET  ,RDIMAG(2 ) , 

2  RDRFS(2) ,RDRAS(2),RDRHB(2).RDRFWL(2) ,RDRAWL(2) ,RDTFS(2) ,RDTAS(2), 
2  RDTHBd),RDTFWL(2),RDTAWL(2),NSBSET,SBIMAG(2),S0BRFS(2) .S0BRAS(2) 
2 .SOBRHBd) ,S0BRFU(2) ,saBRAW(2) ,SIBRFS(2) ,SIBRAS(2) ,SIBRHB(2) , 

2  SIBRFW(2) .SIBRAW(2) .SETFS(2) ,SBTAS(2) ,SBTHB(2) ,SBTFWL(2) , 

2  SBTAWL(2) ,NFNSET,FN1HAGC2) .FNRFS(2) .KNKAS(2) , 

2  FNRHB(2),FNRFWL(2),FNRAyL(2) ,FKTFS(2) ,FNTAS(2) ,FNTHB(2) , 

2  FNTFWL(2) .FNTAWL(2) ,NEXPRD,EKRD0(8) ,ENRDS(8) 

COMMON  /ENVIOR/  VK , BVK . MU , NMU . OMEGA , NOMEGA .SIGMA  , NSIGMA .  SIC.UH . 

1  HSIGWH.TMODAL.NTMOD.NRANG.RANG.RLANG.S.NNMU.FRNUM.VFS 
INTEGER  NVK.NMU, NOMEGA. NSIGMA, NS1GWB.NTM0D,HRANG,NNMU(8) 

REAL  VK(8)  ,MU(37,8)  .OMEGAOO)  ,SIGMA(10)  ,SIGWH(4)  .TMODALO)  , 

2  RANG(8) ,RLAKG(8) ,SC30,8) ,FRNUM(8) .VFS(8) 

COMMON  /GEOM/  X .KSTATN ,Y ,Z .NOFSET.LPP , BEAM .DRAFT ,LCF , 

1  VCG , GM , DELGM , NEBLA .KPITCH .KROLL ,KVAW .KYAWRL , AWP , VCB , FBDX . FBDY , 

2  FBDZ , NFREBD , XPT , YPT , 2PT , KPTS , LCB , GML , ASTAT , BSTAT , TITLE . MASS . 

2  DISPLM , IPITCH . IROLL . lYAU , lYAWRL .CHEAVE, CPITCH , CHEAPI , CROLL , 

2  AREAMX.VSURF, GIRTH, FBDZV.DBLWL.TLCB 

INTEGER  HSTATN.N0FSET(25) , NFREBD, NPTS 

REAL  X(2S) ,Y( 10,25) ,Z( 10 .26 ) ,FBD2V(8 . lo) ,LPP .BEAM .DBLWL ,TLCB , 

2  DRAFT, LCF , VCG ,GM, DELGM .NEBLA .KPITCH .KROlL.KY AW .KYAWRL, AWP .VCB , 

2  FBDX(10),FBDY(10) .FBDZCIO) ,XPT(10) .YPT(IO) .2PT(10) , LCB, GML, 

4  ASTAT(26),BSTAT(26) .TITLE(20) .MASS , DISPLM, IPITCH , IROLL, lYAW . 

6  I YAWRL , CHEAVE , CPITCH , CHEAPI , CROLL , AREAMX , WSURF , GIRTH ( 26 ) 

COMMON  /PHYSCO/  II, TPI , PI, PIOT, DEGRAD, RADDEG,VKMETR,METRVK,GRAV, 
2  RHO ,GNU ,RHOS , RHOF .GNUS ,GNUF .FTMETR.PUNITS , REVSCL 
COMPLEX  II 

CHARACTER*4  PUNITS(2) 

REAL  TPI, PI, PIOT, DEGRAD, RADDEG,VKMETR,METRVK,GRAV. RHO, GNU, RHOS, 

1  RHOF, GNUS, GNUF.FTMETR 

COMMON  /RLDBK/  PSUR(25) , BMK(26) ,DK(26) ,CAK (25) ,HQ .HSPAN . HMNCHD , 

2  HAREA .HXCP ,HYCP .HZCP .HGAMMA .HYHAT.HEAR ,HLCS ,RQ(2) ,RSPAH(2) , 

2  KMNCHD(2) ,RAREA(2) ,P.XCP(2) ,RYCP(2) ,RZCP(2) ,RGAHMA(2) ,RYHAT(2) , 

2  REAR(2),RLCS(2) ,SQ{2) .SSPAN (2) .SMNCHD(2) ,SAREA(2) ,SXCP(2) . 

2  SYCP(2),SZCP(2) ,SGAMMA(2).SYHAT(2),SEAR(2),SLCS(2),BQ(2) , 

2  SEPAK(2) ,EKHCHD(2) .RaRF.A (21 , RXCP(2) ,BYCP(2) .BZCP(2) ,BGAMMA(2) , 
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C4  a  a  a  a  c*  a  a  a 


BYHAT(2) ,BEAR(2) ,B;XS(2) .FQ(2) ,FSPAK(2> ,FHNCHD(2) .KAREA ( 2 ) . 
FXCP(2)  ,FYCP(2) ,FZCP(2) ,FGAMMA(2) ,FYHAT(2) ,FEAR(2' .FLCS(2) . 
PQ(2,2)  ,PSPAN(2.2) ,PMKCHD(2.2) .PAREA (2 .2) , PXCP(2 ,2) , PYCP (2 , 2 ) , 
PZCP(2,2),PGAMMA(2,2) .PYHAT(2,2),PEAR(2,2KpLCS(2,2) , 

STADMP(IO)  ,SHPDMP(10,8) .ENCON ,WPH1 .TPHI .VMELM(4 , 9) , SFELM(4 , 9 , 8 ) , 
REEI.M(4,9,B)  ,PEELK(4,9.e)  ,FEELM(4  ,9,6)  ,HEELM(4,9,e)  ,  BEEL.M(4 , 9 , 8 )  . 
ENWM.ENSF(e,8) .ENRE(e) .ENPE(P) .ENFE(B) .ENHE(8) .ENBECe^ , 

ENEHVCe.e)  .ENRL(e)  ,ENPL(8)  ,ENFL(6  )  ,nMlL(6 )  ,  F.NSE(  8 )  ,  ENB1,(C)  , 
ENSHP(6.8) ,RELM(4,9) ,ITS(2B) ,RD(25),EDDY(6,25) ,RGBC2&) 

REAL  RDBLK(2692) 

EQUIVALENCE  (PSUR( 1 ) ,RDBLK(1 ) ) 

REAL  LCS,MCHORD 

IF  (NRDSET  .EQ.  0)  GO  TO  20 
EN  =  0 

STASPC  =  LPP/20 
DO  10  K=1 , NRDSET 
XRTF  =  LCB  -  RDRFS(K)*STASPC 
XRTA  =  LCB  -  RDRAS(K)*STASFC 
XTPF  =  LCB  -  RDTFS(K)*STASPC 
XTPA  =  LCB  -  RDTAS(K)*STASPC 
YRT  =  RDRHE(K) 

YTP  =  RDTHB(K) 

ZRT  =  (RDRFWL(K)  +  RDRAVL(K))/2  -  (DBLWL-tVCG) 

2TP  =  (RDTFUL(K)  +  RDTAUL(K))/2  -  (DBLWL+VCG) 

SPAN  =  SQRT((ZRT-ZTP)*'*2  +  (YTP-YRT)**2) 

Q  =  RDIMAG(K) 

MCHORD  =  0.5*((XTPF-XTPA)  +  (XRTF-XRTA)) 

CR  =  XRTF  -  XRTA 
CT  =  XTPF  -  XTPA 
XRQC  =  XRTF  -  0.26*CR 
XTQC  =  XTPF  -  0.28*CT 
DX  =  XRQC  -  XTQC 
H  =  SQRT(DX*DX  +  SPAN*SPAN) 

COisLAH;  =  SPAK/H 
SECLAK2  =  i ./(COSLAM^COSLAM) 

■»  LAM  =  ACQS(SPAN/H)  =  quarter  chord  sweep  angle  in  radians 

e  area 

AREA  =  SPAN*HCHORD 

e  canter  ol  pressure 

ZP  =  0.6* (ZRT  +  2TP) 

YP  =  0.6* (YRT  +  YTP) 

XO  «  0.6* (XRTF  +  XTPF) 

XCP  =  XO  -  0.25*MCH0RD 
YCP  -  YP 
ZCP  =  Zp 

*  moment  arm 

ARG  =  (ZRT-ZTP)  /  SPAN 
GAMMA  =  •  90 

IF  (ARG  .LT.  1)  GAMMA  =  -  AS1N(ARG)*RADDEG 

GAM  s  GAMMA*DEGRAC 

YBAT  =  YCP*COS(GAM)  +  ZCP*SIN(GAM) 

*  effective  aspect  ratio 

EAR  =  2*SPAN/MCH0RD 
■*  lift  curve  slope 

LCS  =  1 .8*PI*EAR/(C0SLAM*SQRT((EAR*SECLAM2)**2  +  4)  +  1.8) 

RQ(K)  =  Q 
RSPAN(K)  =  SPAN 
RMNCHD(K)  =  MCHORD 
RAREA(K)  =  AREA 
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RXCP(K)  =  xcr 
RYCP(K^  *  YCP 
R7CP(K^  =  ZCP 
RGAMMA(K)  =  GAKHA 
RYHAT(K)  =  YHAT 
REAR(K)  =  EAR 
RLCS(K)  »  l.CS 

EN  =  EN  -4  Q*(RI10/2)*AREA*LCS*YHAT*YHAT*UPHI*ENC0N 
10  CONTINUE 
20  CONTINUE 

DO  30  IV^l.NVK 
ENRL(IV)  ^  0. 

IF  (NRDSET  .GT.  0)  ENRL(IV)  =  EK*VFS(1V) 

30  CONTINUE 


RETURN 

END 

C  DECK  RDPELH 

SUBROUTINE  RDPELM 

*  reads  spline  element  data  tor  2-d  potentials  and  torces 

♦  W.R.MCCREIGHT  DTNSRDC  JULY. 1977 

COMMON  /CH3D/  ISIGMA , SIGMIN , SIGMAX . V . SINMU . COSHU , VTSl . 

2  IMMIN.IMHAX.IHDEL.LMIN.LMAX 

REAL  SICHIN  , SIGMAX, V, SINMU, COSKU.UTSI (4) 

INTEGER  ISIGMA . IMHIN , IMMAX . IKDEL.LMIN ,LMAX 

COMMON  /GEOM/  X . NSTATN .Y ,Z .WOFSET . LPP . BEAM . DRAFT ,LCF , 

1  VCG , GM , OELGM , NEBL A . KPITCH , KRQLL . KY AW , K Y  AWRL , AUP , VCB . FBDX , FED Y , 

2  FED2,NFREBD,XPT,YPT,2PT,NPTS,LCB,GHL,ASTAT,BSTAT. TITLE, MASS, 

2  DISPLM.1PITCH,IROLL,IYAW.IYAWRL.CHEAVE,CPITCH,CHEAPI,CROLL, 

2  AREAMX ,WSURF, GIRTH, FBDZV.DBLWL.TLCB 

INTEGER  NSTATN, N0FSET(26),NFREBD.NPTS 
CKARACTEReC  TITLE(20i 

REAL  X(26) .YCIO^He) ,Z(10,25).FBD2V(8,10),LPP,BEAM,DBLWL.TLCB, 

2  DRAFT , LCF , VCG , CM, DELGM , NEBLA , KPITCH .KROLL, KYAW , KYAURL , AWP , VCB , 
2  FBDX(10),FBDY(10) ,PBD2(10) ,XPT(10) ,YPT(10) ,ZPT(10) ,LCB,GML. 

4  ASTAT(26) .BSTAT(26) .MASS ,D1SPLM, IPITCH , IROLL. lYAV , 

6  TYAWRL.CHEAVE.CPITCH.CHEAPI.CROLL, AREAMX, WSURF, GIRTH (2B) 

COMMON  /INDEX/  PFIDX .LPFIDX .RMIDX.LRMIDX.SVlDX.LSVIDX 

INTEGER  LPFIDX, LRMIDX.LSVIDX 

REAL  PFIDX(236) .RMIDX(l83) .SVIDX(3) 

COMMON  /lO/  SYSFIL,POTFIL,COFFIL.LCOFIL,ICARD,TEXFIL,IPRIN, 

2  SCRFIL , HPLFIL , LRAFIL .ORGFlL.RAOFIL .RMSFIL, SEVFIL.SPDFIL . 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL,P0TFIL,C0FFIL,LC0FIL.ICARD,TEXFIL,1PRIN, 

2  SCRFIL, HPLFIL, LRAFIL. ORGFlL.RAOFIL, RMSFIL, SEVFIL.SPDFIL, 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /PELEM/  PELEM 
COMPLEX  PELEM(4,1000) 

COMMON  /STATE/  LAT, VRT, LOADS. ADDRES, SALT. HEAD, EXROLL, DKEEL 
LOGICAL  LAT , VRT .LOADS , ADDRES , SALT , HEAD , EXROLL, BKEEL 

DIMENSION  DATA(320) 

INTEGER  PSTORE 


I0DSK=0 

PSTDRE=1 

DO  1  ISTATN=1 .NSTATN 

INDEX=(ISIGMA-1)*NSTATN+1STATK 

NNODE=NOFSET(ISTATN) 

IFCNNODE  .LT.  2)  GO  TO  1 
NDATP=0 

IF  (VRT)  NDATP=16*NN0DE 
IK  tLAt)  NuATF-SDATF > IC’SwCDE 


*  change  for  VAX/VMS  version 

+  CDC  CALL  READMSCPOTFIL, DATA, KDATP, INDEX) 

READ  (POTFIL,REC=INDEX)  DATA 

NEXT=1 

DO  2  J=l,NHODE 

DO  3  :.HDDE=IMHIK,1MMAX,1KDEL 

DO  4  i  =  l,4 

PELEH (1 , PSTORE ) =CMPLX ( D ATA ( N  EXT  > . DAT A (NEXT^ 1 ) ) 

NEXT=NEXT+2 
4  CONTINUE 

PSTOREtPSTORE+1 
3  CONTINUE 
2  CONTINUE 

NCDSK=NODSK+NNODE 

IF  ((NEXT-1) -NE.NDATP)  WRITE  (IPRIN,60l)  ISIGHA , ISTATN 
GOl  FORMAT  (//•  warning  -  IN  RDPELM  FOR  ISIGHA  =  '.IF, 

+  ’  AND  ISTATN  =  ’.If,/ 

+  '  NO.  OF  DATA  ELEMENTS  READ  IS  NOT  EQUAL  TO  NO.  OF  DATA’, 

+  ’  ELEMENTS  UNPACKED’//) 

1  CONTINUE 

RETURN 

END 

C  DECK  RDPRIN 

SUBROUTINE  RDPRIN 

COMMON  /APPEND/  KBKSET , NBKSTN (2) .BKIMAG (2) ,BKFS(2) , BKAS (2 ) , 

2  BKWD(2) ,BKSTN(10.2) ,BKHB(10,2).BKLNTH,BKWDTH, 

2  BKWL(10,2)  .BKAN(10,2) .NSKSEr,SKIMAG(2) ,SKFL.S(2) .SKALS(2) , 

2  SKAUS(2) ,SKHB(2) ,SKFLWL(2) ,SKALUL(2) ,SKAUWL(2) ,NRDSET.RDIMAG(2) , 

2  RDRFS(2) ,RDRAS(2J,RDRHB(2) ,RDRFWL(2) .RDRAWL(2) ,RDTFS(2) ,RDTAS(2), 
2  RDTHB(2),RDTFUL(2),RDTAUL(2),NSBSET.SBIMAG(2) ,S0BRFS(2) ,S0BRAS(2) 
2,S0BRKE(2/ ,EOBrvFW(2) ,S0ERAU(2) .£IBRrS(2) ,£IERAS(2) ,SIERHB(2) . 

2  SIBRFW(2) ,SIBRAW(2) ,SBtFS(2) ,SBTAS(2) ,SBTHB(2) ,SBTFWL(2) , 

2  SBTAWL(2) .NFNSET,FNIMAG(2) .FNRFS(2) .FNRAS(2) , 

2  FNRHB(2),FNRFUL(2),FHRAWL(2),FNTFS(2).FNTAS(2) ,FNTHB(2) , 

2  FNTFWL(2) ,FNTAWL(2) ,NEXPRD,ENRD0(8) ,ENRDS(8) 

COMMON  /ENVIOR/  VK, NVK. MU, NMU, OMEGA, NOMEGA .SIGMA, HSIGHA.SIGWH, 

1  NSIGWH .TMODAL , NTMOD , NRANG , RANG . RLANG ,S , NNMU .FRNUM , VFS 
INTEGER  NVK . NMU . NOMEGA , NSIGMA , NSIGWH . NTMOD , NRAN G , NHHU (8 ) 

REAL  VK(8) ,MU(37,C) ,OMEGA( 30) ,SIGMA( 10) ,SIGWH(4) ,TM0DAL(8) , 

2  RAKG(8) .RLANG(8) .S(30,8) ,FRNUM(8) .VFS(6) 

COMMON  /GEOM/  X , NSTATN ,Y ,Z .NOFSET . LPP , BEAM .DRAFT, LCF , 

1  VCG.GM.DELGM .HEBLA .KPITCH .KROLL .KYAW.KYAWRL.AWP .VCB.FBDX ,FBDY . 

2  FBDZ , NFREBD , XPT , YPT , ZPT . NPTS . LCB , GML , ASTAT , BSTAT , TITLE , M ASS , 

2  DISPLM.IPITCH.IROLL.IYAW.IYAWRL.CHEAVE.CPITCH.CHEAPI.CROLL, 

2  AREAMX.VSURF, GIRTS, FSDZV.DELWL.TLCE 

INTEGER  NSTATN .N0FSET(2B) .NFREBD, NPTS 
CKARACTER*4  TITLE (20) 

REAL  X(2E),Y(10,2S) .Z(10 ,26) .FBDZV(8. lO) .LPP .BEAM.DBLVL.TLCB , 

2  DRAFT , LCF ,VCC , CM, DELGM .HEBLA .KPITCH .KROLL.KYAW .KYAWRL , AWP , VCB , 

2  FBDX(10),FBDY(10) ,FBDZ(10).XPT(10) ,YPT(lO) .ZPT( 10) ,LCB .GML , 

4  A3TAT(2E) ,BSTAT(26) .MASS.DISFLM.IPITCH.IROLL.IYAW, 

6  lYAURL.CHEAVE.CPITCH.CHEAPI.CROLL.AREAMX, USURP, G1RTK(2B) 

COMMON  /lO/  SYSFIL,POTFIL,COFFIL,LCOF1L,ICARD,TEXFIL,IPR1N, 

2  scrfil,hplfil,lrafil,drgfil,raofil,rmsfil,sevfil,spdfil, 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL.POTFIL.COFFIL.LCOFIL.ICARD.TEXFIL.IPRIH, 

2  SCRFIL,HPLFIL,LRAF1L,0RGFIL,RAQFIL,RMSFIL,SEVF1L,SPDFIL, 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /PHYSCO/  II ,TPI , PI ,PIOT, DEGRAD .RADDEG .VKHETR.METRVK .GRAY , 
2  RHO , GNU . RHOS , RHOF . GNUS . GNUF . FTMETR , PUN ITS . REYSCL 
COMPLEX  II 

CHARACTEH*4  PUNllS(2> 

REAL  TPI , PI . PIOT .DEGRAD . RADDEG , VXMETR . METRVK , GRAV , RHO , GNU , RHOS . 
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1  RHQF.GNUS.GNUF.FTMETR 

COMMON  /RLDBK/  PSUR(25) ,BKK(25) ,DK(25) ,CAK(?5) ,HQ,HSPAN,HMNCHD, 

2  HAREA,HXCP,HYCP,KZCP,HGAMKA,HYHAT,HEAR,HLCS.RQ(2).RSPAN(2) , 

2  RMNCHD(2) ,RAREA(2) ,RXCP{2) ,RYCP(2) ,RZCP(2) .RGAMMA(2) ,RYHAT(2) . 

2  REAR(;2) .RLCS(2) ,Sq(2) .SSPAN (2) ,SMNCHD(2) .SAREA(2) ,SXCP(2) , 

2  SYCP(2),S2CP(2) ,3GAMMA(2) , SYHAT(2) ,SEAR(2) ,SLCS (2) , BQ (2 ) , 

2  BSPAH(2) ,BMNCHD(2) ,BAREA(2) ,BXCP(2) ,bYCP(2) .BZCP(2) ,BGAHMA(2) , 

2  BYHAT(2) ,BEAR(2) .BLCS(2) ,FQ(2) ,FSPAN(2) ,FMMCHD(2)  FAREA(2) , 

2  FXCP(2) ,FYCP(2) ,FZCP(2) ,FGAMMA(2) ,FYHAT(2) ,FEAR(2) ,FLCS(2) , 

2  Pq(2,2hPSPANC2,2).PMNCHD(2,2),PAREA(2,2),PXCP(2,2) ,PYCP(2,2) , 

2  P2CP(2,2),PGAMMA(2,2),PYHAT(2,2),PEARC2.2) .PLCS(2,2) , 

2  STADMP ( 10 ) .SHPOHP (10,8), ENCON ,WPHI ,TPHI ,WMELM(4 , 9 ) , SFELM (4 .9.8), 

2  REELM(4,9,8).PEELM(4,9,8).FEELM(4.9,8) ,HEELM(4,9 ,8) ,BEELM(4,9.8) , 
2  ENWM,ENSF(8,8) ,ENRE(8) .ENPE(8) ,ENFE(8) ,ENHE(8) ,EHBE(8) . 

2  ENEMV(8 ,8) ,ENRL(8) ,ENPL(8) ,ENFL(8) ,ENHL(8) .ENSL(8) ,ENBL(8) , 

2  ENSHP(8,8) ,RELM(4,9) ,ITS(25) ,RD(25) ,EDDY(8,26) ,RGB(25) 

REAL  RDBLK(2692) 

EQUIVALENCE  (PSUR(l) ,RDBLK(1 ) ) 

DIMENSION  TEMP(8) 

CHARACTER*4  METER 

DATA  METER/ 'METE*/ 

WRITE  (IPRIN.IOOO)  TITLE 

*  ship  particulars 

DIGPLT  =  MASS*. 001 

IF  (PUNITS(i)  .NE.  METER)  DISPLT  =  MASS*GRAV/2240 . 

WRITE  (IPRIN,1010)  LPP,GM. BEAM, KROa, DRAFT, WPHI, DISPLT, TPHI 

*  hull  and  appendage  particulars 

WRITE  (IPRIN.1020) 

WRITE  ( IPRIN , 1030 )  HQ , HGAKMA , KHNCHD , HSPAN , HAREA , HXCP , HYCP , HZCP , 

2  HYHAT.HEAR.HLCS 

IF  (NSKSET  .GT.  0)  WRITE  (IPRIN. 1040)  (SQ(I) .SGAMMA(I) .SMNCHD(I) , 
2  SSPAN(I) .SAREAd) ,SXCP(I) ,SYCP(I) .SZCP(I) ,SYHAT(I) ,SEAR(I) , 

2  SLCS(I), 1=1, NSKSET) 

IF  (NRDSET  .GT.  0)  WRITE  (IPRIN, lOSO)  (RQd) ,RGAMMA(I) ,RMNCHD(I) , 
2  RSPAN(I) .RAREAd) ,RXCP(I) .RYCP(I) ,RZCP(I) ,RYHAT(I) ,REAR(I) , 

2  RLCSd), 1=1, NRDSET) 

IF  (NSBSET  .EQ.  0)  GO  TO  4 
DO  2  K=l, NSBSET 
M  =  2 

IF  (SBTHB(K)  .EQ.  0.)  M  =  1 

WRITE  (IPRIN, 1066)  (Pq(K,L) ,PGAMMA(K,L),PMNCHD(K,L) ,PSPAN(K,L) , 

2  PAREA(K,L. ,PXCP(K,L) ,PYCP(K ,L) ,PZCP(K,L) ,PYBAT(K ,L) ,PEAR(K ,L) , 

2  PLCS(K,L) ,L=1,M) 

2  CONTINUE 
4  CONTINUE 

IF  (NBKSET  .GT.  0)  WRITE  (IPRIN, 1060)  (BQ(I) .BGAMMAd) ,BMNCHD(I) , 
2  BSPAN(I) .BAREA(l) ,BXCP(I) ,BYCP(I) ,BZCP(I) ,BYHAT(I) ,BEAR(I) , 

2  BLCSd), 1=1, NBKSET) 

IF  (NFNSET  .GT.  0)  WRITE  (IPRIN, 1070)  (FQd) ,FGAMMA(I) ,FMNCHD(I) . 
2  FSPANd)  ,FAREA(I)  ,FXCP(I)  .FYCPd)  ,F2CP(I)  ,FYHAT(I)  ,FEARd) , 

2  FLCS (I), 1=1, NFNSET) 

*  total  roll  decay  coefficient,  N 

WRITE  (IPRIN, 1076) 

WRITE  (IPRIN, 1080)  (RLANG(IA) ,IA=1 ,NRANG) 

DO  10  IV=1,NVK 

WRITE  (IPRIN,  1090)  VK(IV)  ,  (ENSHPdV,IA)  ,IA=1  ,NRANG) 

10  CONTINUE 

WRITE  (IPRIN, 1000)  TITLE 

*  roll  decay  coefficients  grouped  by  hull  and  appendages 

WRITE  (IPRIN, 1100) 


118 


hull  and  skeg 

WRITE  (IPRIK.lllO)  ^  ^ 

WRITE  (IPRIN.loeO)  (RLANG(IA),IA=1,NRANG) 

DO  30  IV=1,NVK 

DO  20  IA=1,NRANG  , 

ENHEV  =  EDMKSP(WPHI,LPP,VFS(IV)  .EKHEdA))  .tvn 

TEMP(IA)  =  ENWM  +  ENSF(IV,IA)  +  ENHEV  +  ENHL(IV)  +  ENSL(IV) 

WRITE**(IPR1N.1090)  VK(IV) , (TEMP(IA) ,IA=1.NRANG) 

30  CONTINUE 

rudder 

IF  (NRDSET  .EQ.  0)  GO  TO  60 
WRITE  (IPRIN,1120) 

WRITE  UPRIN.IOSOJ  (RLANGCIA) ,IA=1 .NRANG) 

DO  60  1V=1,NVK 
DO  40  IA=1, NRANG 

ENREV  =  EDMKSP(UPHI,LPP,VFS(IV).ENRE(IA)) 

TEMP(IA)  =  ENREV  +  ENRL(IV) 

WRITE**(IPRIN,1090)  VK(IV) , (TEMP(IA) ,IA=1 .NRANG) 

50  CONTINUE 
60  CONTINUE 

propeller  shait  brackets 

IF  (NSBSET  .EQ.  0)  GO  TO  66 

WRITE  aPRIN,1125)  ,  ^ 

WRITE  UPRIN.IOSO)  (RLANGCIA; .IA=1 .NRANG) 

DO  64  IV=1,NVK 

DO  62  IA  =  1, NRANG  ^  ^ 

ENPEV  =  EDMKSPCWPHI.LPP.VFSdV)  ,ENPE(IA)) 

TEMP(IA)  =  ENPEV  +  ENPLCIV) 
cokttkue 

WRITE  (IPRIN,1090)  VKCIV)  ,  (TEMPdA)  ,IA=1  .NRANG) 

64  CONTINUE 
66  CONTINUE 


bilgekeel 

IF  (NBKSET  .EQ.  0)  GO  TO  90 


WRITE  (IPRIH,1130)  ^  ^ 

WRITE  (IPRIN.IOSO)  (RLANGCIA) ,IA=1 .NRANG) 

DO  80  IV=1,NVK 

DO  70  IA=1. NRANG  ,  ^ 

TEMP(IA)  =  ENBE(IA)  +  ENBL(IV) 

70  CONTINUE 

WRITE  (IPRIN.1090)  VK(IV) . (TEMP(IA) .IA=1, NRANG) 
80  CONTINUE 
90  CONTINUE 


IF  (NFHSET  .EQ.  0)  GO  TO  120 

writ!  [iPRIN’.lOBoi  (RLANG(IA)  ,IA=1. NRANG) 

DO  110  IV=1,NVK 

DO  100  IA=1, NRANG  ,  ^ 

ENFEV  =  EDMKSP(WPHI,LPP,VFS(IV),ENFE(IA)) 

TEMP(IA)  =  ENFEV  +  ENFL(IV) 

100  wK"(IPEIN.1090)  VK(IV).(TEMP(IA).IA=1. NRANG) 

110  CON  :nue 
120  CONTINUE 

WRITE  (IPRIN.IOOO)  TITLE 

roll  decay  coailicients  grouped  by  damping  mechanism 
WRITE  (IPRIN.llSO) 
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*  wavemeiking 

WRITE  (IPRIN,1160)  ENWM 

*  skin  friction 

WRITE  (IPRIN,1170) 

WRITE  (IPRIH.IOSO)  (RLANG(IA) ,1A=1 .NRANG) 

DO  130  1V=1,NVK 

WRITE  (IPRIN,1090)  VK(IV) , (ENSF(IV , lA) , IA=i .KRANG) 

130  CONTINUE 

*  eddymaking  (excluding  bilgekeel) 

WRITE  (IPRIN.llSO) 

WRITE  (IPRIN.IOSO)  (RLANG(IA) .IA=1 .NRANG) 

DO  140  IV=1,NVK 

WRITE  (IPRIN,1090)  VK(IV) , (ENEMV(IV,IA) .IA=i .NRANG) 

140  CONTINUE 

IF  (NBKSET  .EQ.  0)  GO  TO  145 

*  bilgekeel  eddymaking 

WRITE  (IPRIN,1190) 

WRITE  (IPRIN,1200)  (RLANG(IA) .IA=1 .NRANG) 

WRITE  (IPRIN.1206)  (EKBE(IA) .IA=1 .NRANG) 

145  CONTINUE 

*  lift  N  values 

WRITE  (IPRIN.1210) 

DO  ISO  IV=1,NVK 

ENLFT  =  ENHL(IV)  +  ENSL(IV)  +  ENRL(IV)  +  ENPL(IV)  <•  EHBL(IV) 

2  +  ENFL(IV) 

WRITE  (IPRIN.1090)  VK(IV) .ENEL(IV) .ENSL(IV) ,ENRL(IV) .ENPL(IV) . 

2  EKBL ( I V ) . ENFL ( IV ) . ENLFT 
ISO  CONTINUE 

1000  FORMAT  (1H1.9X.20A4//) 

1010  FORMAT  (40X.16HSHIP  PARTICULARS//32X .8HLPP  =.F8.2.8X. 

2  7HGM  =.F6.2/32X.8HBEAM  =.F8.2.8X.7HKR0LL  =.F6.2.1HB/32X. 

2  8HDRAFT  = .F8 .2.8X,7HWPHI  =.F6.3/32X,8HDISPLM  =.F8.0.8X. 

2  7HTPHI  =,F6.2) 

1020  FORMAT  (////35X.30HHULL  AND  APPENDAGE  PARTICULARS// 17X . 

2  34HQ  GAMMA  MCHORD  MSPAN  AREA,6X,3HXCP,6X.3HYCP.6X.3HZCP. 
2  4X.4HyH AT. 6X. SHEAR, 6X.3HLCS/) 

1030  FORMAT  ('  HULL  ’ ,F8.0,F8.1,7FB.2,2F8.3) 

1040  FORMAT  ('  SKEG  ’ .F8.0,F8.1,7F8.2,2F8.3) 

1050  FORMAT  (•  RUDDER  * ,F8.0,F8.1,7F8.2.2F8.3) 

1056  FORMAT  (’  BRACKET  ’ ,F8.0,F8.1,7F8.2,2F8.3) 

1060  FORMAT  (’  BILGEKEEL’ ,F8.0,F8. 1,7F8. 2, 2F8. 3) 

1070  FORMAT  (’  FIN  ’ .F8.0,F8.1,7F8.2,2F8.3) 

1075  FORMAT  (////35X,30HSHIP  ROLL  DECAY  COEFFICIENT,  N) 

1080  FORMAT  (/13X . lOHSHIP  SPEED , 17X ,20HMEAN  ROLL  ANGLE  (SA)/15X, 

2  7H(KN0TS).23X,9H(DEGREES)/23X,8F7.1/) 

1090  FORMAT  (16X,F4.0,3X,8F7.3) 

1100  FORMAT  (33X,34HR0LL  DECAY  COEFFICIENTS  GROUPED  BY/ 

2  40X,19HEULL  AMD  APPENDAGES) 

1110  FORMAT  (//40X,19HBARE  HULL  PLUS  SKEG/25X, 

2  49H (WAVEMAKING,  SKIN  FRICTION,  EDDYMAKING,  AND  LIFT’)) 

1120  FORMAT  (//45X,6HRUDDER/37X,22H(EDDYMAKING  PLUS  LIFT)) 

1126  FORMAT  (,//36X ,24HPR0PELLER  SHAFT  BRACKETS/37X, 

2  22H (EDDYMAKING  PLUS  LIFT)) 

1130  FORMAT  (//43X.9HBILGEKEEL/37X,22H(EDDYMAKING  PLUS  LIFT)) 

1140  FORMAT  (//47X,3HFIN/37X.22H (EDDYMAKING  PLUS  LIFT)) 

1160  FORMAT  (33I,34HR0LL  DECAY  COEFFICIENTS  GROUPED  BY/43X, 

2  13HDAMPING  TYPES) 

1160  FORMAT  (//40X, 12HWAVEMAKING  =,F7.3) 

1170  FORMAT  {//42X, 13HSKIN  FRICTION) 

1180  FORMAT  (//32X,33HEDDYMAK1NG  (EXCLUDING  BILGEKEELS)/30X, 

2  38H(HULL,  SKEG,  RUDDER,  BRACKET,  AND  FIN)) 

1190  FORMAT  (//38X,20iiDiLGc,K££L  EDDYHAKInG) 
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1200  FORMAT  (/40X ,20HMEAN  ROLL  ANGLE  (SA)/4SX, 9H(DEGREES) /23X , 8F7 . 1/ ) 
120E  FORMAT  (23X.8F7.3) 

1210  FORMAT  (//47X.4HLIFT//13X, lOHSHIP  SPEED, 

2  49H  HULL  SKEG  RUDDER  BRACKT  BILGKL  FIN  TOTAL/ 15X, 

2  7H (KNOTS)/) 

RETURN 

END 

C  DECK  RDSHPSYS  -  Read  SMPSYS.TEX  FILE 
SUBROUTINE  RDSMPSYS 

COMMON  /ID/  SYSFIL,POTFIL.COFFIL,LCOFIL,ICARD,TEXFIL,IPRIN, 

2  SCRFIL , HPLFIL , LRAFIL .QRGFIL . RAOFIL . RMSFIL . SEVFIL , SPDFIL , 

2  SPTFIL,LACFIL,LAEFIL 

INTEGER  SYSFIL,POTFIL,COFFIL,LCOFIL,ICARD.TEXFIL,IPRIN, 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL , SEVFIL . SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /SHPSYS/  FIS, AS. SIS, SOS, SDS, HALOS, DEV, PRN.SMPPS.SMPIS, 

2  SMPOS , SMPDS , SHPTYPS , SHIPS . VARS , CYCLS .TITLES , OPTION ,LSIS , LSOS , 

2  LSDS.LHALOS,LDEV,LPRN,LSMPPS,LSMPIS,LSMPOS,LSMPDS,LSHFTYPS. 

2  LSHIPS.LTITLES 
CHARACTER* 160  AS 

CHARACTER*80  FIS .SIS , SOS .SDS .TITLES 

CHARACTER+20  HALOS ,DEV , PRN , SMPPS . SMPIS , SMPOS , SMPDS .SHPTYPS 
CHARACTER  SHIPS*6 , VARS*2 ,CYCLS*2 
IHTEGER*2  OPTION 

10  FORMAT  (A) 

FIS  =  'SMPSYS.TEX' 

OPEN  (SYSFIL .FILE=FIS , STATUS= ' OLD ' ) 

READ  (SYSFIL, 10)  AS  !  HALO  program  path 

CALL  SLENTH  (AS.LHALQS) 

HALOS  =  AS(19:LHAL0S) 

LHALOS  =  LHALOS  -  18 

READ  (SYSFIL, 10)  AS  !  HALO  graphics  screen  driver 

CALL  SLENTH  (AS.LDEV) 

DEV  =  AS(29:LDEV) 

LDEV  =  LDEV  -  28 

READ  (SYSFIL, 10)  AS  !  HALO  printer  driver 

CALL  SLENTH  (AS.LPRN) 

PRN  =  AS(21:LPRN) 

LPRN  =  LPRN  -  20 

RF*D  (SYSFIL, 10)  AS  !  SMP  program  path 

Cl'v,  SLENTH  (AS.LSMPPS) 

SMPPS  =  AS(18:LSMPPS) 

LSMPPS  =  LSMPPS  -  17 

READ  (SYSFIL, 10)  AS  !  SMP  input  path 

CALL  SLENTH  (AS.LSMPIS) 

SMPIS  =  AS(16:LSMPIS) 

LSMPIS  =  LSMPIS  -  16 

READ  (SYSFIL, 10)  AS  !  SMP  output  path 

CALL  SLENTH  (AS.LSMPOS) 

SMPOS  =  AS(17:LSMP0S) 

LSMPOS  =  LSMPOS  -  16 

READ  (SYSFIL, 10)  AS  !  SMP  data  path 

CALL  SLENTH  (AS.LSMPDS) 

SMPDS  =  AS(1B:LSMPDS) 

LGMPDS  =  LSMPDS  -  14 

READ  (SYSFIL, 10)  AS  !  Ship  type 

CALL  SLENTH  (AS .LSHPTYPS) 
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SHPTYPS  =  AS(11 ;LSHPTYPS) 
LSHPTYPS  =  LSHPTYPS  -  IP 


(SYSFIL.IO)  AS  !  Current  ship 

CALL  SLENTH  (AS.LSHIPS) 

SHIPS  =  AS(14:LSH1PS) 

LSHIPS  =  LSHIPS  -  13 
IF  (LSHIPS  .GT.  6)  LSHIPS  =  5 

READ  (SYSFIL.IO)  AS 
VARS  =  AS(9;9) 

READ  (SYSFIL.IO)  AS 
CALL  SLENTH  (AS, LAS) 

CYCLS  =  AS (7: LAS) 

CALL  SLENTH  (CYCLS .LCYCLS) 

READ  (SYSFIL.IO)  AS 
CALL  SLENTH  (AS.LTITLES) 

TITLES  =  AS(9:LTITLES) 

LTITLES  =  LTITLES  -  8 

READ  (SYSFIL.IO)  AS 
READ  (AS, '(TX.ia) ’)  OPTION 

CLOSE  (SYSFIL) 

SIS  =  SKPIS(l:LSHPIS)//-\‘//SHPTYPS(l:LSHPTYPS)//’\’// 
2  SHIPS ( 1 ; LSHIPS ) //VARS( 1 : 1) //CYCLS( 1 : LCYCLS ) 

CALL  SLENTH  (SIS.LSIS) 

SOS  =  SMPQS(l:LSMPOS)//’\'//SHPTYPS(l:LSHPTYPS)//-\’// 
2  SHIPS ( 1 : LSHIPS ) //VARS (1:1) //CYCLS ( 1 : LCYCLS ) 

CALL  SLENTH  (SOS.LSOS) 

SDS  =  SMPDS(l:LSMPDS)//’\'//SHIPS(l:LSHIPS)//'\’// 

2  SHIPS(l;LSHIPS)//VARS(l:l) 

CALL  SLENTH  (SDS.LSDS) 

RETURN 

END 

C  DECK  READ 

SUBROUTINE  READ 


!  Hull  variant  letter 
!  Cycle  number 

!  Title 

!  Option  number 


COMMON  /APPEND/  NBKSET,NBKSTN(2) ,BKIMAG(2) .BKFS(2) ,BKAS(2) , 

2  BKWD (2 ) , BKSTN (10,2), BKHB (10,2), BKLNTH , BKWDTH , 

2  BKWL(10,2),BKAN(10,2) ,NSKSET,SKIMAG(2) ,SKFLS(2) .SKALS(2) , 

2  SKAUS(2) ,SKHB(2),SKFLWL(2),SKALWL(2),SKAUWL(2),NRDSET,RDIMAG(2), 

2  RDRFS(2) ,RDRAS(2),RDRHB(2) ,RDRFWL(2) ,RDRAWL(2) ,PJ)TFS(2) ,RDTAS(2) , 
2  RDTHB(2),RDTFWL(2),RDTAWL(2),NSBSET,SEIMAG(2),S0BRFS(2) ,S0BRAS(2) 
2,S0BRHB(2) ,S0BRFW(2) .S0BRAW(2) .SIBRFS(2) ,SIBRAS(2) ,SIBRHB(2) , 

2  SIBRFW(2) ,SIBRAW(2) .SBTFS(2) ,SBTAS(2) ,SBTHB(2) ,SBTFWL(2) , 

2  SBTAWL(2) ,NFNSET,FH1MAG(2) ,FNRFS(2) ,FNRAS(2) . 

2  FNRHB(2),FNRFWL(2),FNRAWL(2) ,FNTFS(2) ,FNTAS(2) .FNTHB(2) , 

2  FNTFWL (2 ) , FNTAWL(2 ) , NEXPRD , ENRDO (8 ) , ENRDS ( 8 ) 

COMMON  /DATIKP/  OPTN,MOTN,BSCFIL,VLACPR,RAOPB,RLDMPR,DISPLMT, 

2  LRAOPR , AD RPR , ORGOPTN , GMNOM , KG .STATN ( 25 ) , NSOFST ( 25 ) , 

2  NLEWF(26),HLFBTH(10,26) ,WTRLHE(10 ,25) ,BLEWF(26) ,TLEWF(2B) , 

2  AREALF(25) ,NPTL0C.PTNUMB(10) ,PTNAME,XPTL0C(10) ,YPTLDC(lo) . 

2  ZPTLOC(IO) ,NBB,FBNUMB(10) ,FBNAME,XPTFBD(10) ,YPTFBD(lO) , 

2  ZPTFBD (10), FBCODE ( 10 ) , FBTYPE , RDOT ( 10 ) , VKDES , FNDES , 

2  STATNM.STATIS 

CHARACTER+4  PTNAME(8 , 10) ,FBNAME(8 ,10) ,STATHM(6) ,FBTYPE(3 , 10) 
INTEGER  OPTN , MOTN , BSCFIL , VLACPR , RAOPR , ADRPR , RLDMPR, FBCODE , 

2  FBNUMB.PTNUMB, ORGOPTN 
REAL  KG 


1 


COMMON  /ENVIOR/  VK , H VK , Mu , NHu .OMEGA .KOHEGA , 3IGKA , SSIGKA , SIGWK , 
NSIGWH , TMODAL . NTMOD . NRANG , RANG , RLANG , S , NNMU , FRNUM , VFS 
INTEGER  NVK , NMU , NOMEGA , NSIGMA .NSIGWH . NTMOD , NRANG , NNMU (8 ) 
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REAL  VK(8) ,MU(37,8) ,0MEGA(30) ,SIGMA( 10) ,SIGWH(4) ,TMQDAL(8) , 

2  RANG(8) ,RLANG(8) ,3(30,8) .FRNUM(8) ,VFS(8) 

COMMON  /FINCON/  lACTFN , IFCLCS ,FGAIN(8) .FK(3) ,FA(3) ,FB(3) , 

2  FCLCS(8,2) 

COMMON  /GEOM/  X .NSTATN ,Y ,Z ,NOFSET ,LPP .BEAM , DRAFT ,LCF , 

1  VCG,GM,DELGM,NEBLA,KPITCH,KRQLL,KYAW,KYAWRL.AWP,VCB,FBDX,FBDY, 

2  FBDZ , NFREBD . XPT , YPT . ZPT . NPTS , LCB , GML , ASTAT , BSTAT , TITLE , M ASS , 

2  DISPLH . IPITCH . IROLL , lYAW , lYAWRL , CKEAVE , CPITCH . CHEAPI . CRQLL , 

2  AREAMX . VSURF .GIRTH , FBDZV .DBLWL . TLCB 

INTEGER  NSTATN, N0FSET(2B) , NFREBD, NPTS 
CHARACTER*4  TITLE(20) 

REAL  X(25) ,Y(10,25) ,Z(10,25) .FBDZV(8 . 10) .LPP .BEAM .DBLWL , TLCB , 
DRAFT, LCF,VCG,GM,DELGM,NEBLA.KPITCH,KROLL,KYAW,KYAURL,AWP,VCB, 
FBDX(IO) .FBDYdO) .FBD2(10) .XPT(IO) ,YPT(10) ,2PT(10) .LCB.GML, 
ASTAT(25) .BSTAT(2S) , MASS, DISPLM, IPITCH, IROLL. lYAW, 
lYAWRL , CHEAVE . CPITCH . CHEAPI , CROLL . AREAMX , WSURF , GIRTH (25 ) 

COMMON  /INDEX/  PFIDX  .LPFIDX  .RMI.DX  .LRMIDX.SVIDX  .LSVIDX 
INTEGER  LPFIDX, LRMIDX, LSVIDX 
REAL  PF1DX(236) ,RMIDX(183) ,SVIDX(3) 

COMMON  /lO/  SYSFIL.PQTFIL.CQFFIL.LCOFIL.ICARU.TEXFIL.IPRIN, 

2  SCRFIL , HPLFIL , LRAFIL , QRGFIL , RAOFIL .RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL , POTFIL , COFFIL .LCOFIL .ICARD .TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /LOADS/  NLOADS ,SWGHT(25) ,SMASS(2E) ,XLDSTN(10) ,XLDXPT(25) . 
2  LSTATN(26) 

COMMON  /PHYSCO/  II ,TPI , PI .PICT, DEGRAD .RADDEG .VKMETR.METRVK ,GRAV , 
2  RHO . GNU , RHOS , KHQF , GNUS , GNUF . FTMETR .PUNITS , REYSCL 
COMPLEX  II 

CHARACTER'»4  PUNITS(2) 

REAL  TPI , PI , PIOT , DEGRAD , RADDEG , VKMETR , METRVK , GRAV , RHO , GNU , RHOS , 

1  RKOF, GNUS, GNUF, FTMETR 

COMMON  /RESPN/  NRESP .IP0INT(182) ,IM0TN(182) ,ITYPE(182) , 

2  ILIN(182) ,ISYM(182) 

LOGICAL  ILIH.ISYH 

COMMON  /SMPSYS/  FIS .AS .SIS .SOS ,SDS .HALOS, DEV, PRN ,SMPPS ,SMPIS  , 

2  SMPOS , SMPDS , SHPTYPS , SHIPS , VARS , CYCLS , TITLES . OPTION , LSIS , LSOS , 

2  T,SDS , LH ALOS , LDEV , LPRN , LSMPPS , LSMPIS , LSMPOS , LSMPDS , LSHPTYPS , 

2  LSHIPS.LTITLES 
CHARACTER* 160  AS 

CHARACTER*80  FIS .SIS .SOS ,SDS .TITLES 

CHARACTER*20  HALOS , DEV, PRN .SHPPS .SMPIS, SMPOS, SMPDS .SHPTYPS 
CHARACTER  SHIPS*6 , VARS*2 , CYCLS*2 
INTEGER*2  OPTION 

COMMON  /STATE/  LAT, VRT, LOADS .ADORES, SALT, HEAD. EXROLL, BKEEL 
LOGICAL  LAT , VRT , LOADS , ADORES , SALT , HEAD , EXROLL , BKEEL 

CHARACTER*4  ALL, ROLL, EqVLIN 

CHARACTER*4  ROOT . TIP , ROOTOB , ROOTIB .LINES , LEWIS , TLEWIS 
INTEGER  HFE 

DIMENSION  FREOlOO)  ,FREQ2(30)  .FREQ3(30)  ,FREq4(30) , 

2  P(2,10) .PSEGS(8,9) 

CHARACTER*4  SLAM(3) ,EMEG(3) ,SUBM(3) .STNMl (3) 

CHARACTER*4  METER 


DATA  METER  /’METE’/ 

DATA  SLAM  /’  SLA’ , ’MMIN’ , 'G  '/ 
DATA  EMEG  /’  EME’ , ’RGEN’ , ’CE  ’/ 
DATA  SUBM  /’  SUB’ , ’MERG’ , 'ENCE’/ 
DATA  FREOl  /. 2, .25, .28, .3, .32, .34, 
.625, .55  .576, .6, .625, .65, .675, .7, 
DATA  FPELI2  /. 2,  .25,  .3,  .36,  .4,  .425, 


.36, .38, .4, .42, .44,^46,^48, .5, 
.75, .8, *9,1., 1.1, 1.2, 1.0, 2./ 
.46, .475,. 5, .625, .55, .575, .6, 
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2  .65, .7, .75, .8, .65, ,9, ,95,1. ,1.1, 1.2, 1.3, 1.4, 1.6, 1.8, 2. ,2. 2, 2. 4/ 

•  DATA  FREQ3  /. 2, .3, .4, .5, .6, .7, .8, .85. .9, .95, 1.0, 1.05, 1.1, 1.15, 

f  2  1.2, 1.3, 1.4, 1.6, 1.6, 1.7, 1.8, 1.9, 2., 2. 2, 2. 4, 2, 6, 2. 8, 3. 0,3, 5, 4.0/ 
DATA  FREQ3  / . 2 , . 3 . . 4, . 6 , . 65 , . 576, . 6 , .625, . 66 , . 675 , . 7 , . 725 , .75  , 

2  .775,. 8,. 825,. 85,. 9,. 95,1., 1,1, 1.2, 1.3, 1.5,1. 8, 2., 2. 5, 3., 3. 5, 4./ 
DATA  FREq4  /. 2, .4, .6, .8,1. ,1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9, 

2  2., 2. 1,2. 2, 2. 3, 2. 4, 2. 5, 2. 6, 2, 7, 2. 8, 2. 9, 3., 3. 2, 3. 4, 3. 6, 3. 8, 4./ 
DATA  ALL, ROLL  /’ ALL ROLL >/ 

DATA  STNMl  / ’SIGN ’ , ’ IF . A ' , ’MPL. ' / 

DATA  EQVLIN  /’EQVL’/ 

DATA  ROOT. TIP  /’ ROOT *, ’TIP ’/ 

DATA  ROOTOB.RQOTIB  / ’RTOB ’ , *RT1B */ 

DATA  LINES, LEWIS  /’LINE' , 'LEWI'/ 

WRITE  (IPRIN  990) 

990  FORMAT  (1H1.49X,22HINPUT  CARD  DESCRIPTION) 

FIS  =  SIS(1:LSIS)//’ .INP’ 

OPEN  (UNIT=ICARD , FILE=F1S , STATUS^ ’OLD ’ ) 


DATA  CARD  SET  1  -  TITLE 

READ  (ICARD.IOOO)  TITLE 
WRITE  (IPRIN, 1010)  TITLE 
1000  FORMAT  (;20A4) 

1010  FORMAT  (///26H  DATA  CARD  SET  1  -  TITLE/SX , 20A4) 


*  DkTA  card  SET  2  -  PROGRAM  OPTIONS 

READ  (ICARD.1025)  OPTN , VLACPR.RAOPR .RLDMPR.LRAOPR , ADRPR .ORGOPTN 
WRITE  (IPRIN, 1030)  OPTN .VLACPR.RAOPR, RLDMPR.LRAOPR, ADRPR .ORGOPTN 
1026  FORMAT  (1615) 

1030  FORMAT  C'//35H  DATA  CARD  SET  2  -  PROGRAM  0PTI0NS//4X .BHOPTION , 

2  4X , 6HVLACPR , 6X , BHR AOPR . 4X . 6HRLRMPR , 4X . 6HLRA0PR , 6X , 5H ADRPR , 3X , 

2  7H0RG0PTN/7I105 


♦  DATA  CARD  SET  3  -  PHYSICAL  UNITS 

READ  (ICARD,1040)  PUNITS.RHO.GRAV.GNU 
WRITE  (IPRIN, 1050)  PUNITS.RHO.GRAV.GNU 
1040  FORMAT  (2A4,2X,2F10.4,F10.8) 

1050  FORMAT  (///34H  DATA  CARD  SET  3  -  PHYSICAL  UNITS//6X,6HUNITS,6X, 
2  3HRH0 , 6X , 4HGRAV , 6X , 3HGNU/2X , 2A4 ,2F10 . 4 , FIO . 8 ) 


%  DATA  CARD  SET  4  -  HULL  PARTICULARS 

READ  <ICARD,1060)  LPP, BEAM, DRAFT. DSPLMT,VKDES,VKINC.AMODL 
WRITE  (IPRIN, 1070)  LPP , BEAM, DRAFT. DSPLMT.VKDES .VKINC . AMODL 
1060  FORMAT  (3F10.4,F10.2,3F10.4) 

1070  FORMAT  (///36H  DATA  CARD  SET  4  -  HULL  PARTICULARS//6X,3HLPP , 
2  7X , 4HBEAM , 5X , 5HDRAFT , 4X , 6HDSPLMT , 5X , 5HVKDES , 5X , 5HVKINC , 5X , 

2  BHAMODL/3F10.4,F10.2,3F10.4) 

speed  definition 

IF  (PUNITS(i)  .NE.  METER)  VKMETR  =  VKHETR/FTHETR 

METRVK  =  1. /VKMETR 

CON  =  VKHETR/SqRT(GRAV*LPP) 

IF  (VKINC  .Eq.  0.)  VKINC  =  6. 

IV  =  0 

5  IV  =  IV  +  1 

VK(IV)  =  (IV-1)*VKINC 
VFS(IV)  =  VKMETR*VK(IV) 

FRNUM(IV)  =  CON+VK(IV) 

IF  (VK(IV)  .LT.  VKDES  .AND.  IV  .LT.  8)  GO  TO  6 
NVK  =  IV 

hiiu£.5  =  C0K+VKDE3 
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+  DATA  CARD  SET  6  -  LOAD  PARTICULARS 

READ  (ICARD,1080)  GMNOM  .DELGM.KG .KPITCH .KROLL ,KYAW 
WRITE  (IPRIN,1090)  GMNOM, DELGM.KG, KPITCH, KROLL, KYAW 
1080  FORMAT  (8F10.4) 

1090  FORMAT  (///36H  DATA  CARD  SET  5  -  LOAD  PARTICULARS//5X,5HGMN0H, 
2  5X , BHDELGM , 6X , 2HKG , 6X , 6HKPITCH , 5X , 6HKRQLL , 6X .4HKYAW/ 

2  7F10.4) 


*  DATA  CARD  SET  6  -  HULL  LINES  -  LEWIS  FORM  OR  OFFSETS 

READ  (ICARD,1020)  NSTATN ,NLOADS 
WRITE  (IPRIN,1100)  NSTATN, NLQADS 
1020  FORMAT  (315) 

1100  FORMAT  (///47H  DATA  CARD  SET  6  -  HULL  LINES  -  LEWIS  FORM  OR  , 
2  7H0FFSETS//19H  NO.  OF  STATIONS  =.I3.4X,8HNL0ADS  =,I3// 

2  3X , 7HSTATI0N , 5X , SHNLEWF . 6X , 4HBEAM , 5X , 5HDRAFT , 4X , 6HSEC ARE , 

2  5X,5HDBLWL/) 

DO  70  K=l, NSTATN 

READ  (ICARD,1110)  STATN(K) ,NSOFST(K) ,NLEWF(K) 

1110  FORMAT  (FIO.4,215) 

IF  (NSCFST(K)  .EQ.  0)  HSOFST(K)  =  1 
NP  =  NSOFST(K) 

iF  (NLEWF(K)  .EQ.  0)  GO  TO  20 
TLEWIS  =  LEWIS 

READ  (ICARD,1120)  STATN(K) ,BLEWF(K) ,TLEWF(K) , AREALF(K) ,DBLWL 
1120  FORMAT  (FIO . 4, 10F7 . 2) 

IF  (NP  .GT.  1)  GO  TO  10 
HLFBTH(1,K)  =  0. 

WTRLNE(1,K)  =  0. 

GO  TO  60 

10  CALL  GENOFS  (BLEWF(K) ,TLEWF(K) , AP.EALF(K) ,NP ,HLFBTR(1 ,K) , 

2  WTRLNE(1,K),PI,DBLWL) 

GO  TO  60 

20  TLEWIS  =  LINES 

READ  (ICARD,1120)  STATN(K) , (HLFBTH(J ,K) . J=1 .NP) 

READ  (ICARD.1120)  STATN(K) , (WTRLNE(J ,K) . J=1 ,NP) 

BLEWF(K)  =  2*HLFBTH(1,K) 

IF  (NP  .GT,  1)  GO  TO  30 
TLEWF(K)  =  0. 

AREALF(K)  =  0. 

GO  TO  60 

30  DO  40  J=1,NP 

P(1,J)  =  HLFBTH(J,K) 

P(2,J)  =  WTRLNE(J,K) 

40  CONTINUE 

NPl  =  NP  -  1 

CALL  SPLKAR  (P ,NP , AREALF(K) .PSEGS.HPl) 

AREALF(K)  =  2*AREALF(K) 

ELEWF(K)  =  2*BMAX(NP.HLFBTH(1.K)) 

TLEWF(k)  =  WTRLNE(1,K) 

DO  60  J=1,HP 

IF  (WTRLKE(J,K)  .LT.  TLEWF(K))  TLEWF(K)  =  WTRLNE(J,K) 

60  CONTINUE 

TLEWF(K)  =  ABS(TLEWF(K)  -  WTRLNE(NP.K)) 

AREALF(K)  -  AREALF(K)/(BLEWF(K)*TLEWF(K)) 

60  IF  (NLEWF(K)  .EQ.  0)  WRITE  (IPRIN,1130)  STATK(K) .TLEWIS , 

2  BLEWF(K),TLEWF(K),AREALF(K) 

IF  (HLEWF(K)  .GT.  0)  WRITE  (IPRIN.1130)  STATN(K) .TLEWIS . 

2  BLEWF(K) ,TLEWF(K) ,AREALF(K) .DBLWL 
1130  FORMAT  (F10.4,BX,A4,1HS,4F10.4) 

70  CONTINUE 

WRITE  (IPRIN.llSO) 

1150  FORMAT  (//3X ,7HSTATI0N ,3X ,7HN0FFSET,5X .BHHLEWF , lOX, 

2  4BH0FFSETS-  Y=HALF  BREADTH.  Z=WATERLINE  (FROM  KEEL)) 

DO  80  K=l, NSTATN 
NP  =  NSOFST(K) 

TLEWIS  =  LINES 

IF  (KLEyF(K)  tt.F.WIK  =  I.F.WIS 

WRITE  (IPRIN.llES) 
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1165  FORMAT  (IX) 

WRITE  (IPRIN,1160)  STATN(K) . NP .TLEWIS , (HLFBTH( J . K ) , J= 1 , NP) 
WRITE  (IPRIN,116B)  STATN(K ). NP .TLEWIS , (WTRLNE( J .K ), J= 1 , NP ) 
1160  FORMAT  (FIO . 4 , 1 10 ,5X , A4 , IHS ,4X ,2HY= , 10F7 . 2) 

1165  FORMAT  (FlO . 4 , 110 ,EX  ,  A4 . IHS ,4X , 2HZ= , 10F7 . 2) 

80  CONTINUE 

IF  (NLOADS  .EQ,  0)  GO  TO  86 


read  weight  curve 

READ  (ICARD.IOSO)  (SWQHT(K) .K=i .NSTATN) 

WRITE  (IPRIN,1333) 

1333  FORMAT  (//7X , 12HWEIGHT  CURVE//3X , 7HSTATI0N , 4X, 6HWEIGHT/ ) 
SUMLD  =0.0 

SUMOM  =0.0 
DO  1B7  K=1 , NSTATN 

WRITE  (IPRIN,1080)  STATN (K) ,SWGHT(K) 

SUMLD  =  SUMLD  +  SWGHT(K) 

SUMOM  =  SUMOM  +  SWGHT(K)  ♦  STATN(K) 

157  CONTINUE 

XLDCG  =  (SUMOM  /  SUMLD)  *  (LPP  /  20.0) 

XLDCGN  =  XLDCG  /  LPP 

WRITE  (IPRIN.1334)  SUMLD , XLDCG .PUN ITS .XLDCGN 

1334  FORMAT  (lOHO  TOTAL  =  .FlO . 4 , // . lOX .25H  C.  OF  GRAVITY  (LCG) 
2  F6.2,2A4,4X,12HLCG/LENGTH  ,7X.F7.3) 

read  locations  (stations)  where  loads  are  to  be  calculated 

READ  (ICARD.IOSO)  (XLDSTN(K) .K=l , NLOADS) 

WRITE  (IPRIN,1336) 

1336  FORMAT  (//4X . 14HLQAD  STATIONS-/) 

WRITE  (IPRIN.loeo)  (XLDSTN(K) .K=l. NLOADS) 

86  CONTINUE 


*  DATA  CARD  SET  7  -  BlLGEKEEL  PARTICULARS 

READ  (ICARD,1020)  KBKSET 
WRITE  (IPRIN,U70)  NBKSET 

1170  FORMAT  (///41H  DATA  CARD  SET  7  -  BlLGEKEEL  PARTICULARS//4X, 

2  6HNBKSET/I10) 

BKLNTH  =0. 

BKWDTH  =  0. 

IF  (NBKSET  .EQ.  O)  GO  TO  106 
DO  100  K=l. NBKSET 

READ  (ICARD.lieO)  NBKSTH(K) ,BKFS(K) .BKAS(K) ,BKWD(K) 

WRITE  (IPRIN.llOO)  K,NBKSTN(K).BKFS(K),BKAS(K),BKWD(K) 

1180  FORMAT  (IS . 5X , 3F10 . 4) 

1 180  FORMAT  (//BX , 6HBKSET ,4X ,6HNBKSTK .6X ,4HBKFS ,6X ,4H0KAS . 6X , 4HBKWD/ 
2  21 10 , 3F10 . 4//6X , 6KBKSTK . 6X . 4HBKHB , 6X , 4EBKWL , 6X , 4nBXAN / ) 
BKIMAG(K)  =  2 
NBKS  =  NBKSTK(K) 

DO  90  1=1,KBKS 

READ  (ICARD.lOeO)  BKSTN(I  .K) ,BKHB(I .K) .BKWL(I ,K) .BKAN(I .K) 
WRITE  (IPRIN.IOSO)  BKSTN(I ,K) ,BKHB(I ,K) .BKWLCi .K) .BKAN(I .K) 

90  CONTINUE 

BKLNTH  =  BKLNTH  +  (BKAS(K)  -  BKFS(K) )*LPP/20 
BKWDTH  =  BKWDTH  +  BKWD(K) 

100  CONTINUE 

BKWDTH  =  BKWDTH/NBKSET 
WRITE  (IPRIN,1200)  BKLNTH. BKWDTH 
1200  FORMAT  (/10X,24HTOTAL  BlLGEKEEL  LENGTH  =,F10.4,4X, 

2  14HAVERAGE  SPAN  =,F10.4) 

106  CONTINUE 


•  DATA  CARD  SET  8  -  SKEG  PARTICULARS 

READ  (ICARD.1020}  NSKSET 
WRITE  (iPKi«,l2lO;  HSKsfci 
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1210  FORMAT  (  ///36H  DATA  CARD  SET  8  -  SKEG  PART1CULARS//4X .6HNSKSET/ 
2  110) 

IF  (NSKSET  .EQ.  0)  GO  TO  11& 

WRITE  (IPRIN,1211) 

1211  FORMAT  (//6X,5HSKSET,5X,6HSKFLS.EX.6HSKALS.5X, 

2  6HSK AUS , ex .4HSKHB , 4X , 6HSKFLWL .4X ,6HSKALWL , 4X . 6HSK AUWL) 

DO  110  K=l, NSKSET 
WRITE  (lPRlH,il77) 

1177  FORMAT  (IX) 

READ  (ICARD,1080)  SKFLS(K) ,SKALS(K) ,SKAUS(K)  , 

2  SKHB(K) ,SKFLWL(K) ,SKALWL(K) ,SKAUWL(K) 

WRITE  (IPRIN,1185)  K,SKFLS(K) ,SKALS(K) .SKAUS(K) , 

2  SKHB(K) ,SKFLWL(K) ,SKALWL(K) ,SKAUUL(K) 
use  FORMAT  (I10.7F10.4) 

SKIMAG(K)  =  1 

IF  (SKHB(K)  .NE.  0.)  SKIMAG(K)  =  2 
110  CONTINUE 
116  CONTINUE 


♦  DATA  CARD  SET  9  -  RUDDER  PARTICULARS 

READ  (1CARD,1020)  NRD3ET 
WRITE  (IPRIN.1220)  KRDSET 

1220  FORMAT  (  ///38H  DATA  CARD  SET  9  -  RUDDER  PART1CULARS//4X , 
2  6HNRDSET/I10) 

IF  (NRDSET  .EQ.  0)  GO  TO  125 
WRITE  (IPRIN,1221) 

1221  FORMAT  (//5X , 5HRDSET .2X .CHLOCATION ,4X .6HFWDSTN , 

2  4X , 6H AFTSTN , SX , SHHLFBM , 5X , 5HFWDUL , 5X , 5HAFTWL) 

DO  120  K=l, NRDSET 
WRITE  (IPRIN.1177) 

READ  (ICARD.1080)  RDRFS(K) ,RDRAS(K) ,RDRHB(K) , 

2  RDRFWL(K) .RDRAWL(K) 

WRITE  (IPP.IH,1196)  K,POOT,RORFS(K).RDRAS(K). 

2  RDRHB(K) ,RDRFWL(K) .RDRAWL(K) 

1196  FORMAT  (I10,4X .A4,2X.7F10.4) 

READ  (ICARD.lOeO)  RDTFS(K) ,RDTAS(K) ,RDTHB(K) , 

2  RDTFWL(K) ,RDTAWL(K) 

WRITE  (IPRIN,1195)  K .TIP . RDTFS(K) ,RDTAS{K) , 

2  RDTHB(K) ,RDTFWL(K) ,RDTAWL(K) 

RDIMAG(K)  =  1 

IF  (RDRHB(K)  .NE.  0.)  RDIMAG(K)  =  2 
120  CONTINUE 
125  CONTINUE 


*  DATA  CARD  SET  10  -  PROPELLER  SHAFT  BRACKETS 

READ  (ICARD,1020)  NSBSET 
WRITE  (IPRIH.ieiO)  NSBSET 

1610  FORMAT  (///46H  DATA  CARD  SET  10  -  PROPELLER  SHAFT  BRACKETS// 

2  4X,6HHSBSET/I10) 

IF  (NSBSET  .EQ.  0)  GO  TO  129 
WRITE  (IPRIN,1620) 

1620  FORMAT  ( //6X , 5HSBSET , 2X , 8HL0C ATIQN , 4X . 6HFWDSTH , 4X , eHAFTSTN , 5X , 

2  SHHLFBM, 5X,BHFWDWL,6X,BHAFTWL) 

DO  128  K=l, NSBSET 
SBIMAG(K)  =  2 

READ  (ICARD.lOaO)  SOBRFS(K) ,SOBRAS(K) ,SOBRHB(K) ,SOBRFW(K) , 

2  SOBRAW(K) 

WRITE  (IPRIN,1196)  K .ROOTOB , SOBRFS(K) ,SOBRAS(K) ,SOBRHB(K) , 

2  SOBRFU(K) ,SOBRAW(K) 

READ  (ICARD.IOSO)  SBTFS(K) ,SBTAS(K) ,SBTHB(K) .SBTPWLCK) ,SBTAWL(K) 
WRITE  (IPRIN,1196)  K,TIP,SBTFS(K) ,SBTAS(K) .SBTHB(K) ,SBTFWL(K) , 

2  SBTAWL(K) 

IF  (SBTHB(K)  .EQ.  0.  .AND.  SOBRHB(K)  .EQ.  0.)  SBIMAG(K)  =  1 
IF  (SBTHB(K)  .EQ.  0.  .OR.  SBTHB(K)  .EQ.  SOBRHB(K))  CO  TO  128 
READ  (ICARD.IOSO)  SIBRFS(K) ,SIBRAS(K) .SIBRHBCK) .SIBRFW(K) , 

^  OXDlVA«V.rk/ 

WRITE  (IPR1S,1196)  K .ROOTIB ,SIBRFS(K) ,SIBRAS(K) , SIBRHBCK) , 

2  SIBRFW(K),SIBRAW(K) 
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128  CONTINUE 

129  CONTINUE 


*  DATA  CARD  SET  11  -  FIN  PARTICULARS 

READ  (ICARD,1020)  NFNSET , I ACTFN , IFCLCS 
WRITE  (1PRIN,1230)  NFNSET , 1 ACTFN , IFCLCS 

1230  FORMAT  (  ///36H  DATA  CARD  SET  11  -  FIN  PARTICULARS// 
2  4X ,6HNFNSET,4X ,6HIACTFN ,4X . 6HIFCLCS/3110) 

IF  (NFNSET  .EQ.  01  GO  TO  135 
IF  (I ACTFN  .EQ.  0)  GO  TO  132 
READ  (ICARD.IOSO)  (FGAIN(IV) ,1V=1 ,NVK) 

WRITE  (IPRIN,2010)  ( VK (IV) , IV=1 .NVK) 

2010  FORMAT  (  /22H  SHIP  SPEED  (KNOTS)  =,8F10.3) 

WRITE  (IPRIN,2020)  (FGAIN(IV) .IV=1 ,NVK) 

2020  FORMAT  (  22H  FIN  GAIN  FACTORS  =,8Fl0.3) 

READ  ( ICARD.IOSO)  FK 
WRITE  (IPRIN,2030)  FK 

2030  FORMAT  (//22H  CONTROLLER  CQEFF.  =,3F10.3) 

READ  (ICARD.IOSO)  FA 
WRITE  (IPRIN.2040)  FA 

2040  FORMAT  (  /22H  SERVO  COEFFICIENTS  =,3F10.3) 

READ  (ICARD.IOSO)  FB 
WRITE  (IPRIN.2050)  FB 

2050  FORMAT  (  /22H  COMPENSATION  COEFF . = , 3F10 . 3) 

132  IF  (IFCLCS  .EQ.  0)  GO  TO  136 
WRITE  (IPR1N,2060) 

2060  FORMAT  (//39X . 30HC0RRECTED  FIN  LIFT  CURVE  SLOPE) 

WRITE  (IPR1N,2010)  ( VK( IV ) . IV=1 ,NVK) 

WRITE  (IPRIN,1177) 

DO  134  K=l, NFNSET 

READ  (ICARD.loeo)  (FCLCSdV.K)  ,IV=1  .NVK) 

WRITE  (IPRIN.2070)  K, (FCLCS(IV.K) .IV=1 .NVK) 

2070  FORMAT  (7H  FNSET,I2,13H  -  FCLCS  =.8F10.3) 

134  continue 
136  CONTINUE 

WRITE  (IPR1N,1231) 

1231  FORMAT  (//6X,EHFNSET,2X,8HL0CATI0N,4X.6HFWDSTN,4X, 

2  6H AFTSTN , 5X , 5HHLFBM , 5X , 6HFWDWL , SX , SHAFTWL) 

DO  130  K=l, NFNSET 
WRITE  (IPRIN,1177) 

READ  (ICARD.IOSO)  FNRFS(K) ,FNRAS(K) ,FNRHB(K) , 

2  FKRFWL{K).FHRAWL(K) 

WRITE  (IPRIH.1195)  K , ROaT,FNRFS(K) .FNRAS(K) .FNRHB (K) , 
2  FNRFWL(K) ,FNRAWL(K) 

READ  (ICARD.1080)  FNTFS(K) .FKTAS(K) .FNTHB(K) . 

2  FNTFWL(K) .FNTAWL(K) 

WRITE  (IPRIH.1195)  K .TIP .FNTFS(K) ,FHTAS(K) .FHTHB(K) . 

2  FNTFWL(K).FHTAWL(K) 

FHIMAG(K)  =  1. 

IK  (KNhfiB(K)  ,NE.  0.)  Fi>IKAG(K)  2. 

130  CONTINUE 
136  CONTINUE 


*  DATA  CARD  SET  12  -  MOTIONS  AT  A  POINT 

READ  (ICARD.1020)  NPTLOC.HFE 
WRITE  (IPRIN,1240)  NPTLOC.HFE 

1240  FORMAT  (  ///39H  DATA  CARD  SET  12  -  MOTIONS  AT  A  P0IHT//4X, 

2  6HHPTL0C . 19X . 3HHFE/I 10 , 20X . 12/) 

IF  (NPTLCC  .EQ.  0)  GO  TO  146 
WRITE  (IPRIN.1241) 

124 1  FORMAT  ( //4X , 6HHUMBER . 8X .4HN AKE . 39X . 6HXPTL0C . 4X . 6HYPTL0C . 4X . 
2  6H2PTL0C) 

DO  140  K=1.NPTL0C 
WRITE  (IPRIN.1177) 

READ  (ICARD.1260)  PTNUMB(K) . (PTNAHEd ,K) . 1^1 .8) ,XFTLOC(K ) . 

2  YPTLQC(K) .2PTL0C(K) 

WRITE  dPRIH.1260)  PTNUMB(K) , (PTNAME(1 ,r) , 1=1 ,6) , aPTLGC(K) . 

2  YPTLQC(K) .2PTL0C(K) 


128 


12‘-.0  FORMAT  ( 1 S  .  6X  ,  8A4 .  eX  ,  3F10 . 4 ) 
1260  FORMAT  (  HO ,  4X ,  eA4 . 1 U  .  3F10 . 4  ^ 
140  CONTINUt 
14&  CONTIKUF, 


•  DATA  CARD  SET  13  -  RELATIVE  MOTION 

READ  PICARD, 1020)  NFRLBD.NBB 
WRITE  (1PRIN,1270)  KFREBD.NBB 

1270  FORMAT  (  ///36H  DATA  CARD  SET  13  -  RELATIVE  MOTION// 

2  4X,6KNFREBD,4X,3HNBB/I10.17) 

IF  (NFREBD  .E(J.  0)  GO  TO  ISB 
WRITE  (IPRIN,1271) 

1271  FORMAT  (  //4X , 6HKUMBER , 8X ,4HKAME ,20X .6HFBC0DE, 13X . 6HXPTFBD ,4X , 
2  6HYPTFBD , 4X . 6HZPTFBD , lOX , 4HRDQT ) 

DO  160  K=1 .NFREBD 
WRITE  (IFRIN,11V7) 

READ  (ICARD,1272)  FBNUMBCK ) . (FBNAMEd ,K ) , 1=1 , 6 ) . FBCODEtK) , 

2  XPTFBD(K) .YFTFBD(K) .ZPTFBD(K ) ,RDOT(K) 

1272  FORMAT  ( 15 . 5X  , 5A4 , 16 , EX  .4F10 . 4) 

•  RDOT  =  12+SQRT(LPP/E20)  IN  ENGLISH  UNITS 

•  RDOT  =  3.66*SQRT(LPP/168.E)  IN  METRIC  UNITS) 

IF  (FBCODE(K)  .LE,  0)  FBCQDE(K)  =  1 
J  =  FBCODE(K) 

DO  148  1=1,3 

IF  (J  .EQ.  1)  FBTYPEd.K)  =  SLAMd) 

IF  (J  .EQ.  2)  FBTYFE(I,K)  =  EMEGd) 

IF  (J  ,EQ.  3)  FBTYPEd.K)  =  SUBMd) 

148  CONTINUE 

WRITE  (IPR1N,1273)  FBNUMB(K) ,  (FBKAMEd ,K)  .  1  =  1  , .6)  ,FBCODE(K)  , 

2  (FBTYPEd.K) .1=1,3) ,XPTFBD(K) ,YPTFBD(Ki ,ZPTFBD{K) .RDOT(K) 

1273  FORMAT  (110, 4X,  5A4.15,2K  = , 3A4 .4X , 3F10 . 4 ,4X ,F 10 , 4) 

150  CONTINUE 

156  CONTINUE 


DATA  CARD  SET  14  -  SEASTATE  AND  ROLL  ITERATION 

READ  (ICARD.1280)  NSIGWH .STATIS, (STATNMCI) ,1=1 ,3) 

WRdE  (IPRIN.1290)  NSIGWH, STATIS,  (STATNMd)  ,1=1,3) 

IF  (NSIGWH  .EQ.  0)  GO  TO  16B 
1280  FORMAT  (16.6X,F10.4,6A4) 

1290  FORMAT  (  ///48H  DATA  CARD  SET  14  -  SEASTATE  AND  ROLL  ITERATION// 
2  4X,6HNSIGWH,4X,14HSTATISTIC  (SA) ,4X. 14MSTAT1ST1C  NAME/ 

2  I10,4X,F1D.4.10X,3A4//6X,BHSIGWH/) 

DO  160  K=l. NSIGWH 

READ  (ICAKD.lOeo)  SIGWH(K) 

WRITE  (IPRiN.lOSO)  SIGWH(K) 

160  CONTINUE 
165  CONTINUE 


•  DATA  CARO  SET  16  -  STOP 

READ  (ICARD.IOOO)  STOP 
WRITE  (IPRIK,1310)  STOP 

1310  FORMAT  (///26H  DATA  CARD  SET  16  -  ST0P//4X.4HST0P/4X ,A4) 


*  inactive  data  card  set  used  lor  inputing  particular  responses 
VRESP  “  0 

IF  (KRESP  ,EQ.  0)  GO  TO  200 
WRITE  dPRlN,1306) 

1306  FORMAT  (///40H  DATA  CARD  SET  16  -  RESPONSE  DEFINITI0N//4X . 
2  46HNRESP  POINT  KQTN  TYPE  LIN  SYM/) 

DO  190  IR=1,NRESP 
READ  dCARD,1316)  IP,IM,IT 
1316  FORMAT  (316) 

IFOIST(IR)  =  IP 
IMOTNdR)  =  IM 
ITYPE(IR)  =  IT 
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ILIN(IR)  =  .TRUE. 

ISYM(IR)  =  .TRUE. 

IF  (IP  .CT.  0)  GO  TO  leO 

IF  (IM.EQ.2  .OR.  IH.EQ.s  ,GR.  IM.EQ.G  .OR.  IM.EQ.7) 

2  ILIN(IR)  =  .FALSE. 

GO  TO  18E 

180  IF  ((IM.EQ.l  .OR.  IM.EQ.3)  .AND.  YPTLOC(IP) .NE.O. ) 

2  ILIN(IR)  =  -FALSE. 

IF  (IM  ,EQ.  2)  ILIN(IR)  =  .FALSE. 

IF  ((IK.EQ.l  .OR.  IM.EQ.3)  .AND.  YPTLOC(ir) . NE . 0 . ) 

2  ISYM(IR)  =  .FALSE. 

IF  (1M.EQ.8  .AND.  YPTFBD(IP) .NE.O. ) 

2  ILTN(IR)  =  .FALSE. 

IF  ((IH.EQ.e  .OR.  IM.EQ.9)  .AND.  YPTI 3D(IP) . NE . 0 . ) 

2  ISYM(IR)  =  .FALSE. 

185  WRITE  (IPRIN,1320)  IR,IP01NT(IR) ,IHOTN(IR) .ITYPECIR) .ILIN(IR) , 
2  ISYH(IR) 

1320  FORMAT  (416, 2L8) 

190  CONTINUE 
200  CONTINUE 

CLOSE  (UNIT=ICARD) 

WRITE  (IPRIN,1330) 

1330  FORMAT  (///20H  END  DATA  CARD  SETS) 


*  note  on  REYNOLDS  no.  scaling  lor  Irictional  roll  damping 

*  REYN  =  V*LPP/VKY  Since  viscosity,  VNY,  is  assumed  constant, 

*  REYN  Bcales  as  LFP»*2/T.  The  period  scales  as  SQRT(LPP).  Thus 

*  REYN  scales  as  LPPf*1.6 

REYSCL  -  1 

IF  UMODL  '.GT.  0.)  REYSCL  =  (AMODL/LPP)**! .  B 
hull  lorm  transformations  to  internal  coordinate  system 

*  find  distance  from  baseline  to  waterline,  dblwl 

DBLWL  0. 

DO  205  1=1,NSTATN 
NP  »  NSOFST(I) 

WL  ■=  WTRLNECNP.I) 

IF  (WL  ,GT.  DBLWL)  DBLWL  =  WL 
20.5  CONTINUE 

K  =  NSTATN  +  1 
DO  220  1=1, NSTATN 
K  =  K  -  1 

X(K)  •=  LPP  -  STATH(I)*LPP/20 
NOFSET(K)  =  NSOFSTCI) 

NP  =  N0F3ET(K) 

DO  210  J=1,NP 
Y(J,K)  =  HLFBTH(J,1) 

2U,K)  =  WTRLNEU.I)  -  DBLWL 
IF  (SP  .GT.  1)  GO  TO  210 
Z(J,K)  =  0. 

210  CONTINUE 
220  CONTINUE 

e  MOTIONS-AT-A-POINT  transformation 

IF  (KPTLOC  .EQ.  O)  GO  TO  240 
NPTS  =  NPTLOC 
DO  230  IP=1,NPTS 

XPT(IP)  =  LPP  -  XPTL0C(IP)*LPP/20 
YPT(IP)  s  YPTLOC(IP) 

ZPT(IP)  =  ZPTLOCdP)  -  DBLWL 
230  CONTINUE 
240  CONTINUE 

*  relative  motion  location  transformation 

IF  (NFREBD  .F.Q.  0)  GO  TO  260 

uu  250  iP=i  .liFF.EBD 

FBDX(IP)  =  LPP  -  XPTFBD(ir)*LP?/20 
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FBDY(ir)  =  YPTFED(IF) 

FBDZ(IPi  =  ZPTFBD(IF)  -  DBLWL 
250  CONTINUE 
260  CONTINUE 


*  ENVIOH  delttult  v&lues 

♦  sigma  defaults 


NSIGKA  = 
SIGKA(l) 

10 

.05 

SIGHA(2) 

= 

.  10 

SIGMA(3) 

s. 

.25 

SIGMA(4) 

= 

.60 

SIGMA(6) 

s 

.76 

SIGMA(6) 

1 .00 

SIGMA(7) 

= 

1  .60 

SIGMA(8) 

s 

2.00 

SICMA(9) 

s 

6.00 

SIGMA(lO)  = 

:  10. 

*  heading  definition 


DO  420  IV=1,HVK 
NNMU(IV)  =  13 
NH  =  NNMU(IV) 

DO  410  1H=1,NH 

MUCIH.IV)  =  (1H-1)*16*DEGRAD 
410  CONTINUE 
420  CONTINUE 


wave  frequency  definition 

RGYRAD  =  KROLLeBEAM 
ROLPER  =  10. 

IF  (GHNOM  .GT.  0.)^ 

2  RuLFtR  =  (TPI/nQRi (GRAV) ) 
ICASE  =  0 

IF  (ROLPER  .LE.  16.)  ICASE 
IF  (ROLPER  .LE.  9  ' 

IF  (ROLPER  .LE.  6 
MQNEGA  s  30 
DO  430  IV=1.K0MEGA 
OMEGA  (IW)  =  FREQUIW) 


430 


.)  ICASE  = 

.)  ICASE  =  3 


SORT  V 1 
1 


IF  (ICASE  .EQ.  irOMEGA(IW)  *  FREq2(lU) 
IF  vICASE  .EQ.  2)  OMEGAaw)  =  FREq3(IW) 
IF  (ICASE  .EQ.  3)  OMEGA(IW)  =  FREq4(IW) 
CONTINUE 

IF  (NSIGWH  .GT.  0)  GO  TO  460 


*  seastate  default  values 

•  SS4(2H),  S55(5K),  SS6(SK) ,  AND  3S7(7.6") 

NSIGWH  =  4 

IF  (ICASE  .GT.  0)  GO  TO  433 

SIGWH(l)  =  2.0 

SIGWH(2)  =  3.0 

SIGWH(3)  =  6.0 

SIGWH(4)  =  7.6 

GO  TO  437 

•  SS3(1.EM),  SS4(2M),  SS6(3H),  AND  SS6(BM) 

433  IF  (ICASE  .GT.  1)  GO  TO  436 
SIGWH(;i)  =  1.6 
S1GWH(2)  =  2.0 
S1GUH(3)  =  3.0 
SIGWH(4)  =  6.0 
GO  TO  437 

*  SS2(1M),  SS3(1.BM),  SS4(2M).  AND  SSb(3M) 
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«  * 


435  SIGWHCl)  =1.0 
SIGWH(2)  =1.5 
SIGWH(3  =  2.0 
SIGWHC4)  =  3.0 
437  CONTINUE 

IF  (PUNITS(l)  .EQ.  METER)  GO  TO  4S0 
DO  440  I=1,NSIGWH 
440  SIGWH(I)  =  SIGWH(I)/FTMETR 
45C  CONTINUE 

*  statistic  default  value 

IF  (STATIS  .GT.  0.)  GO  TO  470 
STATIS  =2.00 
DO  460  1=1,3 
STATNM(I)  =  STNMl(I) 

460  CONTINUE 
470  CONTINUE 

*  modal  wave  period  definition 

NTMOD  =  8 
PERINT  =7.0 

IF  (ICASE  -EQ.  1)  PERINT  =5.0 
IF  (ICASE  .EQ.  2)  PERINT  =  3.0 
IF  (ICASE  .EQ.  3)  PERINT  =3.0 
DO  EOO  IT=1. NTMOD 
TMODAL(IT)  =  PERINT  +  (IT-1)  ♦  2. 

define  2-parametor  (significant  wave  height,  modal  wave  period) 
Bretschneider  sea  spectra,  for  unit  significant  wave  height 

CALL  BRWVSP  (NOMEGA , 1 . ,TMODAL(IT) .OMEGA ,S( 1 , IT) ) 

600  CONTINUE 

*  mean  roll  angle  definition 

NRANG  =  8 
RLAHG(l)  =  .60 
RLANG(2)  =1.00 
RLANa(3)  =2.50 
RLANG(4)  =  6.00 
RLANG(6)  =  10.00 
RLANG(6)  =  15.00 
RLANG(7)  =  26.00 
RLA»G(8)  =  40.00 
DO  36  IA=1, NRANG 
RANG(IA)  =  RLAMa(IA)*DEGRAD 
36  CONTINUE 

response  definitions  (mar  of  182) 

*  6*3  =  18  origin 

*  1*3  =  3  fins 

*  10*3*3  =  90  point 

*  1=1  added  resistance 

*  10*(2+3)  =  60  rel+abs 

*  10*2  =  20  loads 

IF  (HRESP  .GT.  0)  GO  TO  680 
IF  (0PTN.NE.3  .AND.  0PTN.NE.6)  GO  TO  610 

*  roll 

L  =  1 

IPOINTd)  =  0 
IMOTN(l)  =  4 
ITYPE(l)  =  1 
ILIi;(l)  =  .FALSE. 

ISYm(i)  =  .TRUE. 
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IF  (.NOT. (VLACPR.GT.O.OR.STATNM(l) .EQ.EQVLIN))  GO  TO  S02 


*  roll  velocity 

L  =  L  +  1 
IP0INT(2)  =  0 
IM0TN(2)  =  4 
ITYPE(2)  =  2 
ILIN(2)  =  .FALSE. 

ISYM(2)  =  .TRUE. 

502  IF  (lACTFN  .EQ.  0)  GO  TO  506 

*  fin  ft  lin  velocity 

Ml  =  1 

IF  (VLACPR  .GT.  0)  Ml  =  2 

DO  505  IT=1,M1 

L  =  L  +  1 

IPOINT(L)  =  0 

IMOTN(L)  =  9 

ITYPE(L)  =  IT 

ILIN(L)  =  .FALSE. 

ISYM(L)  =  .TRUE. 

505  CONTINUE 

608  NRESP=L 
GO  TO  680 

610  CONTINUE 

*  6  DOF  responses  at  the  origin 

L  =  0 

DO  620  J=l,3 
DO  620  1=1,6 
L  =  L  +  1 
IPOINT(L)  =  0 
IMOTN(L)  =  I 
mPE(L)  =  J 

TT  TM  ^  =  TPHF 

IF  (I.Eq.2' .OR. ■l.Eq,4  .OR.  I.Eq.6)  ILIK(L) 
ISYM(L)  =  .TRUE. 

620  CONTINUE 

IF  (lACTFN  .Eq.  0)  GO  TO  626 

*  lin,  fin  velocity,  and  fin  acceleration 

DO  622  IT=1,3 
L  =  L  +  1 
IPOINT(L)  =  0 
IMOTK(L)  =  9 
ITyPE(L)  =  IT 
ILIN(L)  =  .FALSE. 

ISYM(L)  =  .TRUE. 

622  CONTINUE 

626  CONTINUE 

IF  (NPTLOC  .Eq.  0)  GO  TO  636 
IF  (HFE.Eq.O)  GO  TO  628 


*  horizontal  force  estimator 

DO  527  K=  1, NPTLOC 
L=L+1 

IPOINT(L)  =  K 

TMOTKCI.'*  r  IE 

ITYPE(L)  =  1 


.FALSE. 
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ILIN(L)  =  .FALSE. 

ISYM(L)  =  .TRUE. 

527  CONTINUE 

*  RESPONSES  AT  SELECTED  POINTS 

528  DO  530  K=1,NPTL0C 
DO  530  J-1 ,3 

DO  630  1=1,3 
L  =  L  +  1 
IPOINT(L)  =  K 
IMOTN(L)  =  I 
ITYPE(L)  =  J 
ILIN(L)  =  .TRUE. 

IF  ((I.EQ.l  .OR.  I.EQ.3)  .AND.  YPTLOC(K) .NE.O. )  ILIN(L)  =  .FALSE 
IF  (I  .EQ.  2)  ILIK(L)  =  .FALSE. 

ISYMfL)  =  .TRUE. 

IF  ((I.EQ.l  .OR.  I.EQ.3)  .AND.  YPTLOC(K) .HE . 0 . )  ISYM(L)  =  .FALSE 
530  CONTINUE 

535  CONTINUE 

IF  (ADRPR  .EQ.  0)  GO  TO  637 

*  added  resistajice 

L  =  L  +  1 
IPQINT(L)  =  0 
IMOTN(L)  =  7 
ITYPEa)  =  1 
ILIN(L)  =  .FALSE. 

ISYM(L)  =  .FALSE. 

537  CONTINUE 

IF  (NFREBD  .EQ.  0)  GO  TO  670 

*  relative  motions  ajad  velocities  at  points 

DO  660  K=l, NFREBD 
DO  640  J=l,2 
L  =  L  +  1 
IPOIHT(L)  =  K 
IMOTN(L)  =  8 
ITYPE(L)  =  J 
ILIK(L)  =  .TRUE. 

IF  (YPTFBD(K.)  .NE.  0.)  ILIN(L)  =  .FALSE. 

ISYM(L)  =  .TRUE. 

IF  (YPTFBD(K)  .NE.  0.)  ISYM(L)  =  .FALSE. 

640  CONTINUE 
560  CONTINUE 

670  CONTINUE 

IF  (NLOADS  .EQ.  0)  GO  TO  700 
loads  at  specified  stations 
DO  620  K=l, NLOADS 


4c 

1=10 

(H. SHEAR) 

(NOT  CALCULATED) 

4c 

1=11 

(V. SHEAR) 

4c 

1=12 

(T.MOM.) 

(HOT  CALCULATED) 

4c 

1=13 

(V.MOM.) 

4c 

1=14 

(H.MOM.) 

(NOT  CALCULATED) 

DO 

610  1=10, 

14 

IF 

(.NOT.  (I 

.Eq.ll.QR.I.EQ.13)) 

L  =  L  +  1 
IPOINT(L)  =  K 
IMOTN(L)  =  1 
ITYPE(L)  =  1 
ILIN(L)  =  .TRUE. 
ISYM(L)  =  .tRul. 
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610  CONTINUE 
620  CONTINUE 


700  CONTINUE 


NRESP  =  L 
680  CONTINUE 

*  State  definitions 

VRT  =  .TRUE. 

LAT  =  .TRUE. 

LOADS  =  .FALSE. 

IF  (NLOADS  .GT.  0)  LOADS  =  .TRUE. 

ADORES  =  .TRUE. 

*  CDC  IF  (ISKIP  .EQ.  1)  ADDRES  =  .FALSE. 

IF  (ADRPR  .EQ.  0)  ADDRES  =  .FALSE. 

BKEEL  =  .FALSE. 

IF  (NBKSET  .GT.  0)  BKEEL  =  .TRUE. 

EXROLL  =  .FALSE. 

KYAWRL  =  0. 

NEXPRD  =  0 

IF  (NEXPRD  .GT.  0)  EXROLL  =  .TRUE. 

*  modified  to  run  on  VAX/VMS 

IF  (OPTN  .EQ.  6  .AND.  RAOPR  .EQ.  2  .OR.  LKAOPR  .EQ.  2)  GO  TO  B90 

*  open  reoidom  access  files 

LPFIDX  =  235 

*  CDC  CALL  OPENHS  (POTFIL.PFIDX, LPFIDX, 0) 

LRMIDX  =  183 

*  CDC  CALL  OPENMS  (RMSFIL.RMIDX, LRMIDX, 0) 

LSVIDX  =  3 

K  CDC  CALL  OPENHS  (SEVFIL,SVIDX, LSVIDX, 0) 

690  CONTINUE 


WRITE  (IPRIN,’(8F8.3)’)  OMEGA 
WRITE  (IPRIH,’(8F8.3)’)  TMODAL 

RETURN 

END 

C  DECK  REGWAV 

SUBROUTINE  REGWAV 

COMMON  /DATINP/  OPTN, MOTH, BSCFIL,VLACPR, RAOPR, RLDMPR.DISPLMT, 
2  LRAOPR , ADRPR , ORGOPTH , GMNOH , KG , ST ATN ( 25 ) , NSOFST ( 26 ) , 

2  HLEWF ( 26 ) , HLFBTH(  10 , 26 )  ,  WTRLHEC 1 0 , 2.6)  ,  BLEWF ( 26 )  . TLEWF( 25 )  . 

2  AREALF(26),NPTL0C,PTNUMB(10) ,PTNAME,XPTL0C(10) ,YPTL0C(10) , 

2  ZPTLOC(IO) .NBB,FBNUMBC10) ,FBHAME,XPTFBD(10) ,YPTFBD(10) , 

2  ZPTFBD ( 10 ) , FBCODE ( 1 0 ) , FBTYPE , RDOT ( 10 ) , VKDES , FNDES , 

2  STATHH.STATIS 

CHARACTER*4  PTNAME(8, 10) ,FBNAME(8, 10) ,STATNM(5) ,FBTYPE(3 , 10) 
INTEGER  OPTN ,MOTN , BSCFIL , VLACPR , RAOPR, ADRPR , RLDMPR, FBCODE , 

2  FBNUMB,PTNUMB,QRGOPTN 
REAL  KG 

COMMON  /lO/  SYSFIL,POTFIL,COFFIL,LCOFIL,ICARD,TEXFIL,IPRIN, 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL,LACFIL,LAEFIL 

INTEGER  SYSFIL , POTFIL . COFFIL .LCOFIL .ICARD .TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL .LRAFIL , ORGFIL . RAOFIL , RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL,LACFIL,LAEFIL 

COMMON  /SMPSYS/  FIS, AS, SIS, SOS, SDS, HALOS, DEV, PRN,SMPPS,SHPIS, 
2  SMPQS , SMPDS , SHPTYPS , SHIPS , VARS , CYCLS , TITLES , OPTION , LSIS , LSOS , 
2  LSDS , LH ALOS , LDEV , LPRK , LSK? F 3 , L3KFI3 , LSKPOS , L3KPDS , LSHPTYPS , 

2  LSHIPS.LTITLES 
CHARACTER* 160  AS 
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CHARACTERfSO  FIS ,SIS .SOS .SDS .TITLES 

CHARACTER+20  HALOS , DEV ,PRN .SMPPS.SMPIS.SMPOS .SMPDS.SHPTYPS 
CHARACTER  SHIPS+6 . VARS*2 ,CYCLS+2 
INTEGER»2  OPTION 

IF  (OPTN  .Eq.  6  )  GO  TO  10 

IF  (0PTN.NE.2  .AND.  0PTK.NE.3  .AND.  ORGOPTN .EQ . 2)  GO  TO  10 

AS  =  ’(/4X, "CALLING  HYDCAL")* 

WRITE  (♦.AS) 

WRITE  (TEXFIL.AS) 

CALL  HYDCAL 

AS  =  ■(4X, "CALLING  RDBASE")  ' 

WRITE  (♦.AS) 

WRITE  (TEXFIL.AS) 

CALL  RDBASE 

AS  =  ‘(4X. "CALLING  EqMOTN")' 

WRITE  (♦.AS) 

WRITE  (TEXFIL.AS) 

CALL  EQMOTN 

10  CONTINUE 

RETURN 

END 

C  DECK  RELMOT 

SUBROUTINE  RELMOT  (IM.NL.NU.MOTV .MOTL.XPT.YPT.RAOl .PHSl ,RA02 . 

2  PHS2 . HMOT . NPLANE . NQMEG A . OMEGA .COSMU . SINMU , GRA V . RADDEG , IPHS ) 

♦  This  routine  computes  relative  and  absolute  motion 

♦  WAVE  =  EXP(-I(K^(XP^C0SMU  +  YP^SINMU))  +  K+ZP  +  I(WE+T) 

♦  VERT  =  HEAVE  -  XP^PITCH  +  YP+ROLL 

♦  RELMOT  =  VERT  -  WAVE 

♦  W.O. MEYERS.  DTNSRDC.  021679 

COMPLEX  MOTV (NMOT , NOMEGA) , MOTL(NMOT . NOHEGA) . CVER . CWAVE , HEAVE , 

2  PITCH, ROLL. TFN 

DIMENSION  OMEGA(NOMEGA) .RAOl (NOMEGA) , PHSl (NOMEGA) .RA02(N0MEGA) , 
2  PHS2(N0MEGA) 

DO  30  I=NL.NU 
HEAVE  =  MOTV (2. I) 

PITCH  =  M0TV(3.I) 

ROLL  =  K0TL(2.I) 

DO  20  J=l. NPLANE 

IF  (J  .EQ.  2)  ROLL  =  -  ROLL 

TFN  =  HEAVE  -  XPT^PITCH  +  YPT^ROLL 

CVER  =  TFN 

IF  (J  .EQ.  1)  VAVNUM  =  OMEGA(I)+OMEGA(I)/GRAV 

IF  (j  .EQ.  2)  SINMU  =  -  SINMU 

ARG  =  -  WAVNUM*(XPT^COSMU  +  YPT^SINMU) 

AR  =  COS(ARG) 

Al  =  SIN(ARG) 

CWAVE  =  CMPLX(AA,AI) 

TFN  =  CVER  -  CWAVE 

IF  (J  .EQ.  2)  SINMU  =  -  SINMU 

IF  (j  .EQ.  1)  CALL  RAOPHA  (TFN ,RA01(I) .PHSl (I) , RADDEG .IPHS) 

IF  (J  .EQ.  2)  CALL  RAOPHA  (tFN .RA02(l) ,PHS2(l) .RADDEG .IPHS) 

20  CONTINUE 
30  CONTINUE 

RETURN 

END 

C  DECK  REVAL 
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FUNCTION  REVAL  (RSFLKE , WEIGHT) 

DIMENSION  RSPLNE(4) ,WEIGHT(4) 

REVAL  =  0 
DO  10  1=1,4 

REVAL  =  REVAL  +  WEIGHT(I)*RSPLHE(I) 
10  CONTINUE 

RETURN 

END 


C  DECK  RLXTER 

SUBROUTINE  RLITER  (SPINDX,TOINDX,NSPIND,NTOIND,DATA,IC,RLCALC, 


2  ROLL) 


roll  iteration 

COMMON  /DATINP/  OPTN . MQTN .BSCFIL .VLACPR.RAOPR , RLDMPR .DISPLMT , 
2  LRA0PR,ADRPR,0RGQPTN.GMNQM.KG,STATN(25)  NS0FST(25) 

2  NLEWF ( 25 ) , HLFBTH ( 10 . 2S ) , WTRLHE( 1 0 . 25 ) , BLEWF ( 25 ) . TLEWF (  25 ) , 

2  AREALF(2S 5 , NPTLOC , PTNUMB( 10) , PTN AHE , XPTLOC ( 10) , YPTLOC ( 10 ) , 

2  ZPTLOC(IO) .NBB.FBNUMBdO) , FBN AME .XPTFBD(IO) , YPTFBDC 10) , 

2  ZPTFBD(IO) ,FBC0DE(10) ,FBTYPE,RD0T(10) , VKDES , FNDES , 

2  STATNM  STATIS 

CHARACTER+4  PTNAME(8,10) ,FBNAME(8 , 10) ,STATNM(S) ,FBTYPE( 3 , 10) 
INTEGER  OPTN , MOTN , BSCFIL , VLACPR.RAOPR , ADRPR , RLDMPR , FBCODE , 

2  FBNUMB , PTNUMB . ORGQPTN 
REAL  KG 


COMMON  /ENVIOR/  VK . NVK , MU . NMU .OMEGA .NOHEGA .SIGMA , NSIGMA .SIGWH , 
NSIGWH , TMODAL , NTMQD , NRANG , RANG , RLANG .S ,NNMU , FRNUM , VFS 
INTEGER  NVK, NMU. NOMEGA, NSIGMA, NSIGWH, NTMOD, NRANG, NNMU(8) 

REAL  VK(8) ,MU(37,8) ,0MEGA(30) ,SIGMA(10) ,SIGWH(4) ,TM0DAL(8) , 
RANG(8) ,RLANG(8) ,S(30,8) .FRNUM(8 ) ,VFS(8) 


COMMON  /INDEX/  PFIDX.LPFIDX.RMIDX.LRMIDX.SVIDX.LSVIDX 
INTEGER  LPFIDX.LRMIDX.LSVIDX  ^  ^ 

REAL  PFIDX(236) ,RMIDX(183) .SVIDX(3) 


COMMON  /lO/  SYSFIL.POTFIL,COFFIL,LCOFIL.ICARD,TEXFIL.IPRIN, 
2  SCRFIL.HPLFIL.LRAFIL.ORGFIL.RAOFIL.RMSFIL.SEVFIL.SPDFIL, 

2  SPTFIL.LACFIL.LAEFIL  „ 

INTEGER  SYSFIL , POTFIL , COFFIL , LCOFIL , ICARD , TEXFIL , IPKIN , 
2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL .RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 


COMMON  /RESPN/  KRESP ,IP0INT(182) ,IM0TN(182) .1TYPE(182) , 
2  ILIN<182),ISYM(182) 

LOGICAL  ILIN.ISYM 


2 


LOGICAL  LINEAR, SYMMET 
DIMENSION  DATA(432) ,SPINDX(9) . 
R0LL(13,64,4) 


TOIKDX ( 9 ) , RLC ALC (8,24). 


IR  =  1 

DO  5  N=1.NRESP 

IF  (IM0TN(N).Eq.4  .AND.  mPE(H)  .EQ.  1)  IR  ==  K 
5  CONTINUE 
KR  =  IR  +  1 
LINEAR  =  ILIK(IR) 

SYMMET  =  JSYM(IR) 

NPREDH  —  13 

NDATA  =  (2  +  2*NRANG)*NPREDH 
DO  300  IS=1, NSIGWH 
K  =  0 

CON  =  SIGWH(IS)eSTATIS 
DO  200  IT0=1, NTMOD 
DO  100  IV=1,NVK 

CALL*^FETCH  (KR , I V , ITO , DATA , RMIDX , SPINDX .TOINDX , NDATA . LRHiUX , 
2  NVK, NTMOD, RMSFIL) 
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X.P 

(IC  . 

> 
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n  r  ry 
1) 

:£tL/U 

TEMP  =  DATA( 

;l+i) 

he  . 

EQ. 

2) 

TEMP  =  DATA( 

:l+2) 

10 


50 

100 

200 

300 


L  =  2*NPREDH 
DO  10  IA=1,NRANG 

DO  ■  -  - 

IF 
IF 

L  =  L  +  2 

RLCALC(IA,IH)  =  TEMP^CON 
CONTINUE 

CALL°RLITr’ (RLAHG . KRANG , RLCALCC 1 , IH) , ROLL(IH .K , IS) ) 
CONTINUE 
CONTINUE 
CONTINUE 
CONTINUE 

RETURN 

END 

C  DECK  RLITR 

SUBROUTINE  RLITR  (RLANG.NRAHG.RLCALC.RLANS) 
DIMENSION  RLANG(8) ,RLCALC(8) ,DIFF(8) . ELM(4 . 8) 

DO  10  IA=1,NRANG 

DIFF(IA)  =  RLANG(IA)  -  RLCALC(IA) 

10  CONTINUE 
XO  =  0. 

IF  (XO  .GE.  DIFF(l))  GO  TO  20 
RLANS  =  RLCALC(l) 

GO  TO  40 

20  IF  (XO  .LE.  DIFF(NRANG))  GO  TO  30 
RLANS  ==  RLCALC(NRANG) 

GO  TO  40 

30  CALL  SPFIT  (DIFF , RLANG , ELM .KRANG) 

CALL  SPLVAL  (DIFF .NRANG ,ELM , 0 . .RLANS ,DUM, lELM) 

40  CONTINUE 

RETURN 

END 


C  DECK 
2 

1 

2 


10 

20 


30 


RMS 

SUBROUTINE  RMS  (KREC ,RA01 .RA02,IT,N,R,B2,NPREDH,NLCH,N1 ,rJ2,DATA , 
IRESP.NBETA) 

COMMON  /ENVIOR/  VK.NVK, MU. NMU, OMEGA. NOMEGA, SIGMA, NSIGMA.SIGWH, 
KSIGWH . TMODAL , KTMOD , NRANG , RANG . RLANG , S . NNMU .FRNUM , VFS 

INTEGER  NVK, NMU, NOMEGA. NSIGMA.NSIGWH.NTH0D,mNG,HNMU(8) 

REAL  yK(8) ,MU(37.8) ,0MEGA(30) ,SIGMA( 10) .SIGUH(4) ,TM0DAL(8) , 
RANG(8) .RLAHG(8) ,S(30,8) ,FRHUM(8) ,VFS(8) 

DIMENSION  DATA(432),KREC(13),RA01(30,8,13),RA02(30.8,11) ,R(30), 
B2(36) 

REAL  LMS(24) 

CONTINUE 
L  =  2+KPREDH 
DO  60  IA=1.N 
DO  40  IH=1,NMU 

11  =  N1  +  IH 

12  =  K2  -  IH 

IF  (12  .LE.  0)  12  =  12  +  NBETA 
IF  (KREC(IH)  .GT.  0)  GO  TO  10 
LMS(Il)  =  0. 

GO  TO  40 

DO  20  1=1, NOMEGA 

R(I)  =  RA01(I.IA,IH)'»S(I.IT) 

CALL  ALGRNG  (NOMEGA, OMEGA, R,LMS(Iip 
IF  (KREC(IH)  .EQ.  l5  LMS(I2)  =  LMS(Il) 

IF  (KREC(IH)  .EQ.  1)  GO  TO  40 

KH  =  IH  -  1 

DO  30  1=1, NOMEGA 

R(I)  =  RA02(I,IA,KH)*S(I.IT) 
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CALL  ALGRNG  (NQMEGA , OMEGA, R ,LMS(I2) ) 

40  CONTINUE 

DO  50  IPH=1,NPREDH 

CALL  XMSSC  (IPH,B2,L}1S,NLCH,RMSLC,RMSSC) 

IF  (IRESP  -EQ.  7)  GO  TO  45 
RMSLC  =  SQRT(RMSLC) 

RMSSC  =  SQRTCRMSSC) 

45  L  =  L  +  1 

DATA(L)  =  RMSLC 
L  =  L  +  1 
DATA(L)  =  RMSSC 
50  CONTINUE 
60  CONTINUE 

RETURN 

END 

C  DECK  RMSOUT 

SUBROUTINE  RMSOUT 

COMMON  /DATINP/  OPTN.MOTN.BSCFIL.VLACPR.RAOPR.RLDMPR.DISPLMT, 

2  LRAOPR,ADRPR,ORGOPTN,GMNOM,KG,STATN(25) ,NS0FST(25) , 

2  NLEWF(25),HLFBTH(10,25) .WTRLNE(10,25) ,BLEWF(25) ,TLEWi'(25) , 

2  AREALF(25) .NPTLOC ,PTNUHB(10) .PTKAHE . XPTLOC( 10) ,YPTL0C(10) , 

2  ZPTLOC(IO) ,NBB,FBNUMB(10) .FBNAME , XPTFBD(IO) ,YPTFBD(10) . 

2  ZPTFBDUO)  .FBCODEdO)  ,FBTYPE.RD0T(10)  .VKDES , FNDES . 

2  STATNM.STATIS 

CHARACTERf 4  PTNAME(8 . 10) ,FBNAME(8 , 10) ,STATNM(5) ,FBTYPE(3 , 10) 
INTEGER  OPTN , MOTN , BSCFIL , VLACPR , RAOPR , ADRPR , RLDMPR , FBCODE , 

2  FBNUMB.PTNUMB.ORGQPTN 
REAL  KG 

COMMON  /ENVIOR/  VK.NVK, MU, NMU, OMEGA, NOMEGA, SIGMA, NSIGMA.SIGWH, 

1  KSIGWH , TMODAL , NTMOD . NRANG , RANG . RLANG . S , NNMU , FRNUM , VFS 
INTEGER  SVK . NMU . NQMEGA , NSIGM A . NSIGWH , NTMOD . NRANG . NNMU (8 ) 

REAL  VK(8) ,HUC37,8) ,OMEGA(30) ,SIGMA(10),SIGyH(4) ,TM0DAL(8) . 

2  RANG(8) ,RLANG(8) ,S(30,8) ,FRNUM(8) ,VFS(8) 

COMMON  /GEOM/  X.NSTATN ,Y,Z,NOFSET, LPP, BEAM, DRAFT, LCF, 

1  VCG , GM , DELGM , NEBLA , KPITCH , KROLL , KY AW , K Y AWRL , AWP , VCB , FBDX , FED Y , 

2  FBD2 , NFREBD , XPT , YPT , ZPT . NPTS , LCB , GML . ASTAT , BSTAT , TITLE , MASS , 

2  DISPLM , IPITCH , IROLL , lYAW , I YAWRL , CHEAVE , CPITCH , CHEAPI , CROLL , 

2  AREAMX , WSURF , GIRTH , FBDZ V , DBLWL , TLCB 

INTEGER  NSTATN , NOFSET C 25 ) , NFREBD , NPTS 
CHARACTER*4  TITLE(20) 

REAL  X(26) ,Y(10,26) ,Z(10,2B) ,FBDZV(8, 10). LPP. BEAM, DBLWL, TLCB. 

2  DRAFT , LCF , VCG , GM .DELGM .NEBLA , KPITCH .KROLL ,KY AW . KYAWRL , AWP . VCB , 

2  FEDX(10),FBDY(10),FBDZ(10) ,XPT(lO) ,YPT(10) .ZPT(lO) .LCB.GML. 

4  ASTAT(26) ,BSTAT(26) .MASS, DISPLM, IPITCH, IROLL. lYAW, 

5  I YAWRL , CHEAVE , CPITCH , CHEAPI , CROLL , AREAMX , WSURF , G I RTH (2S ) 

COMMON  /INDEX/  PFIDX.LPFIDX.RMIDX.LRMIDX.SVIDX.LSVIDX 

INTEGER  LPFIDX.LRMIDX.LSVIDX 

REAL  PFIDX(23B) ,RMIDX{183) ,SVIDX(3) 

COMMON  /lO/  SYSFIL.POTFIL.COFFIL.LCOFIL.ICARD.TEXFIL.IPRIN, 

2  SCRFIL , HPLFIL , LRAFIL .ORCFIL , RAOFIL.RMSFIL , SEVFIL . SFDFIL . 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL , POTFIL , COFFIL , LCOFIL .ICARD , TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL .ORGFIL , RAQFIL .RMSPIL, SEVFIL , SPDFIL , 

2  SPTFIL.UCFIL.LAEFIL 

COMMON  /LOADS/  HL0ADS,SWGHT(26) .SMASS(26) ,XLDSTN(10) ,XLDXPT(26) , 
2  LSTATN(2B) 


2 

1 


COMMON  /PHYSCO/  II, TPI, PI, PIOT, DEGRAD, RADDEG.VKMETR.METRVK.GRAV, 
RHO , GNU , RHOS , RHOF , GNUS , GNUF , FTHETR , PUNITS , REYSCL 
COMPLEX  II 

CHARACTER*4  PUNITS(2) 


real  Tki, Pi  ,riOT, degrad, RADDEG,VKKETR,Kirr"vVK,GP.Ay 
RHOF , GNUS , GNUF , FTMETR 
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COMMON  /RESPN/  NRESP . IPQINTC 182) , IMOTN (182) . ITyPE(182) , 

2  ILIN(182) ,ISYM(182) 

LOGICAL  ILIN.ISYM 

COMMON  /SEVERE/  NRSIND .RSINDX .NSWIND.SWIHDX .RSVTOE, RV ,RH 
REAL  RSINDX(14) .SWINDX(B) ,RSVT0E(402) 

INTEGER  RV(13),RH(13) 

COMMON  /SHPSYS/  FIS . AS , SIS , SOS ,SDS .HALOS , DEV , PRN , SMPPS , SMPIS , 

2  SMPOS , SMPDS , SHPTYPS , SHIPS , VARS , CYCLS .TITLES , OPTION . LSIS , LSOS . 

2  LSDS.LHALOS.LDEV.LPRN.LSMPPS.LSMPIS.LSMPQS.LSMPDS.LSHPTYPS, 

2  LSHIPS.LTITLES 

character*i60  as 

CH ARACTER*80  FIS . SIS , SOS , SDS .TITLES 

CH ARACTER+20  HALOS , DEV , PRN , SMPPS , SMPIS , SMPDS , SMPDS , SHPTYPS 
CHARACTER  SHIPS+6 . VARS*2 .CYCLS*2 
INTEGERf2  OPTION 

DIMENSION  XIDOll)  .YID(182.5) 

DIMENSION  IMODL(4) ,LSVRSP(13) 

CHARACTER*4  RTITL(2) .RTYPE(3) ,RUNIT(3) , RSPNME(2 . 13) 

CHARACTER* 1  BLANK,BT(80) 

CHARACTER*2  AC(2),AT,AVK 
CHARACTER* 10  PARSl 
CHARACTER*110  PARS, SEA 
CHARACTER* 100  PARS2 
DIMENSION  HDNG(24) 

DIMENSION  DATA(432)  , SPINDX (9)  .TOINDXO)  .RMS( 8 . 24 ) , ROLL(  1 3 , 64 , 4)  , 
2  ELM(4,8) ,RMSTBL(25,8.8) ,T0ETBL(25 , 8 , 8 ) ,TEMRMS(13) ,TEHT0E(13) 
DIMENSION  INDXRL(25) .INDXHD(25) .HEADNG(26) 

LOGICAL  LINEAR, SYMMET 
INTEGER  TOETBL.HEADHG.TEKTOE 
EQUIVALENCE  (IPQINT , YID) , (XID .MRESP) 

CHARACTER*4  METER , MET , FT , AC0ND(3 , 2) , BS , SUHIT 

DATA  METER. MET, FT  /'METE'.’  M,  FT,V 
DATA  LSVRSP  /3. 6, 2, 4, 6, 9, 8, 9, 8, 9, 8, 9, 8/ 

DATA  RSPNME  /'HEAV’ , 'E' , ’PITC’ . 'H’ , ’  SWA’.'Y’,’  ROL’.’L’, 

2  ■  YA’.’W’.'P1VA’.'C','P1LA'.*C’.’P2VA’.’C',’P2LA','C’, 

2  'P3VA’  'C'  .  ’P3LA' ,  'C  .  'P4VA’ ,  *C’ ,  •P4LA’  , 'C'/ 

DATA  INDaRL  /I, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11. 12, 13, 12, 11, 10,9.8,7,6,6, 4, 
2  3  2  1/ 

DATA  INDXHD  /13 , 12 , 11 , 10 ,9,8 ,7 ,6,6 ,4, 3 ,2. 1 ,24,23 ,22 ,21 ,20 , 19 , 18 , 
2  17,16,16,14,13/ 

DATA  HEADNG  /O . 16 . 30,46 ,60,76 ,90 , 106, 120, 136 ,160 , 166 , 180 , 

2  360 ,345,330,316, 300 , 286 , 270 , 255,240 ,226,210,196,180/ 

DATA  HDNG  /O . , 16 . , 30. ,46 , ,60 . ,76. ,90. , 105 . , 120 . , 135 . , 150 . , 165 . . 

2  180. ,195. ,210. ,226, ,240. ,266. .270. ,285. ,300. ,316. ,330. ,345./ 
DATA  AC  /’LC'.'SC’/ 

DATA  BLANK  /’  ’/ 

DATA  ACOHD  /’LONG’ . ’CRES* , ’TED  ’ , ’SHOR’ , ’TCRE’ , ‘STED’/ 

HSVRSP  =  13 
NHEAD  =  24 
NSPIND  =  NVK  +  1 
KTOIND  =  NTMOD  +  1 
NID  -  911 

FIS  =  SDS(1:LSDS)//’ .RMS’ 

OPEN  (UNIT=RMSFIL,FILE=FIS,STATUS=’UNKNOWN’, 

2  ACCESS= ’DIRECT ’,RECL=1760) 

modified  to  run  on  VAX/VMS 
CDC  CALL  READMS  (RMSFIL.XID ,NID, 1) 

READ  (RMSFIL.REC=1)  (XID(I) ,1=1 ,432) 

READ  (RMSFIL,REC=2)  (XID(I) ,1=433 ,796) .L 

IF  (L  .EQ.  NID)  READ  (RMSFIL,REC=3)  (XID(I) ,1=797,911) 


CDC  L  -  LENGTH (RMSFIL) 
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M  =  (L-l)/E 

IF(L  .HE.  HID)  M  =  1B9 


*  M  =  1B9  means  RMSFIL  was  generated  by  SMP81 

*  M  =  182  means  RMSFIL  was  generated  by  SMP84 

K  1 

DO  760  J=l,6 
DO  7E0  1  =  1. M 
K  =  K  +  1 
YID(I.J)  =  XID(K) 

760  CONTINUE 

NRESP  =  MRESP 
DO  770  IS=1,NS1GWH 


*  lind  most  probable  period 

SWH  =  SIGWH(IS) 

IF  (PUNITS(l)  .HE,  METER)  SWH  =  SWH»FTHETR 

*  significant  wave  height  ranges  below  are  in  meters 

*  sea  state  1 

IF  (SWH  .LE,  0.69)  PER  =  S.O 

*  Bea  state  2 

IF  (SWH. GT. 0.69  .AND.  SWH. LE. 1.26)  PER  =  S.O 

*  sea  state  3 

IF  (SWH. GT. 1.26  .AND.  SWH. LE. 1.73)  PER  =  7.0 

*  oea  state  4 

IF  (SWH. GT. 1,73  .AND.  SWH. LE. 2. 24)  PER  =  7.0 

*  sea  state  6 

IF  (SWH, GT. 2. 24  .AND.  SWH. LE. 3.97)  PER  *  9.0 
t  sea  state  6 

IF  (SWH. GT. 3. 97  .AND.  SWH. LE. 6. 34)  PER  =  11.0 

*  sea  state  7 

IF  (SWH. GT. 6. 34  .AND.  SWH. LE. 12.29)  PER  =  15.0 
^  SGa  state  8 

IF  (SWH. GT. 12.29  .AND.  SWH. LE, 18.77)  PER  =  19.0 

*  greater  than  sea  state  8 

IF  (SWH  .GT.  18.77)  PER  =  19.0 

IF  (PER  .LT.  TMODAL(l))  PER  =  TMODAL(l) 

IF  (PER  .GT.  TMDDAL(NTMOD))  PER  =  THODAL(NTMOD) 
IMDDL(IS)  =  1 
DO  760  LT=1,NTM0D 

IF  (ABS(PER-TMODAL(LT))  .LT.  0,0001)  IHODL(IS)  =  LT 
760  CONTINUE 
770  CONTINUE 

ISKPSV  =  0 

IF  (IMOTN(l)  .NE.  1)  ISKPSV  =  1 

*  ISKPSV  =  0  all  motions  -  output  severe  motion  tables 

*  ISKPSV  =  1  roll  motion  only  -  ship  severe  motion  tables 

IF  (ISKPSV  .EQ.  1)  GO  TO  820 
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FIS  =  SDS(1 :LSDS)//* .SEV 

OPEN  (UNIT=SEVFIL,FILE=FIS,STATUS= 'UNKNOWN  ■  . 

2  ACCESS= 'DIRECT ’ ,RECL=1620) 

NSVRSP  =  5  +  2tNPTL0C 
IF  (NSVRSP  .GT.  13)  NSVRSP  =  13 
CALL  SETSEV  (NSVRSP , LSVRSP) 

NRSIND  =  NSVRSP  +  1 
NSWIND  =  NSIGWH  +  1 
NRECD  =  0 
820  CONTINUE 

L  =  -  3 
DO  2  1=1,20 
L  =  L  +  4 
K  =  L  +  3 

READ  (TITLE(I) ,5000)  (BT( I) , J=L,K) 

6000  FORMAT  (4A1) 

2  CONTINUE 
L  =  0 

DO  4  1=1,80 
L  =  L  +  1 

IF  (BT(I)  .NE.  BLANK)  GO  TO  6 
4  CONTINUE 
6  CONTINUE 

IF  (L.EQ.80  .AND.  BT(80) . EQ . BLANK)  L  =  1 
M  =  1.  +  9 

IF  (M  .GT.  80)  M  =  80 

WRITE  (PARSl.BOlO)  (ET(I) ,I=L,M) 

6010  FORMAT  (lOAl) 

WRITE  (PARS2.6020)  TITLE 
6020  FORMAT  (20A4,20X) 

to  speed  polsx  data  and  text  liles 

FIS  =  SDS(1:LSDS)//' .SPD' 

OPEN (SPDFIL, FILE=FIS , ACCESS* ' DIRECT ' . STATUS* 'UNKNOWN ’ , 

2  FORM* ' UNFORMATTED ' . RECL=768 ) 

FIS  =  SDS(1:LSDS)//' .SPT' 

0PEN(SPTFIL,FILE=F1S .STATUS* 'UNKNOWN ' ) 

WRITE  (SPTFIL,6022)  PARS1,PARS2 

6022  FORMAT(A10/A100) 

PRIDIR  =  90. 

SECDIR  =  0. 

WRITE  (SPTFIL.6023)  KVK.NHEAD 

6023  FORMAT (216) 

WRITE  (SPTFIL,6024)  (VK(lV)  ,1V=1 , NVK) 

WRITE  (SPTFIL,6024)  (HDNG(IH)  ,IH=1 .NHEAD) 

6024  F0RMAT(8F10.4) 

*  loop  over  longcrested,  shortcrested  saves 
DO  600  IC=1,2 

CALL  RLITER  (SPINDX.TOINDX,NSPIND,NTOIND, DATA, IC, RMS, ROLL) 


•  change  lor  VAX/VMS  version 

•  CDC  CALL  STINDX  (SEVFIL .RSINDX .NRSIND) 

♦  CDC  DO  7  1=1, NRSIND 

*  CDC  RSINDX(I)  =  0. 

*  CDC  7  CONTINUE 


*  loop  over  response 

DO  400  IR=1,HRESP 
JR  =  0 
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IF  (ISKPSV  .EQ,  1)  GO  TO  1ft 
DC  18  LR-1,NSVR:5P 
IF  (IR  .HE,  LSVRSP(LR))  GO  TO  18 
JR  =  LR 
GO  TO  19 

18  CONTINUE 

19  CONTINUE 
KR  =  IR  +  1 

IP  =  IPOINT(IR) 

IM  =  IMOTK(IR) 

IT  =  ITYPE(IR) 

CALL  RSTITL  ( IP , IK , IT .RTITL , RTYPE , RUNIT .PARS) 
LINEAR  =  ILIN(IR) 

SYMMET  =  ISYM(IR) 

NPREDH  =  13 

IF  (.NOT.  SYMMET)  NPREDH  =  24 
N  =  1 

IF  (.NOT.  LINEAR)  N  =  NRANG 
NDATA  =  (2  +  2*N) •NPREDH 


•  change  lor  VAX/VMS  version 


* 

CDC 

IF  (JR  .EQ.  0)  GO  TO  21 

CDC 

CALL  STINDX  (SEVFIL .SWINDX .NSWIND) 

4 

CDC 

DO  8  1=1, NSWIND 

% 

CDC 

SWINDX (I)  =  0. 

CDC  8 

CONTINUE 

CDC21 

CONTINUE 

loop 

over  signilicant  wave  height 

DO  300  IS=1,NSIGWH 

CON  =  SIGWH(IS)*STATIS 

IF  (IM.EQ.16)  CON  =  SIGWH(IS) 

•  loop  over  modal  wave  period 

K  *  0 

DO  200  IT0“1.NTH0D 

SWHKAX  =  ,202*TM0DAL(IT0)**2 

IF  (PUNITS(l)  .EQ.  METER)  SWHKAX  =  SWHHAX*FTMETR 

•  loop  over  speed 

DO  100  IV=1,NVK 
K  =  K  +  1 

IF  (SIGWH(IS)  .GT.  SWHKAX)  GO  TO  100 

CALL  FETCH  (KR , IV , ITO .DATA , RMIDX .SPIKDX .TOINDX , NDATA .LRMIDX , 
2  NVK.NTKQD.RMSFIL) 

•  loop  over  heading 

L  =  2*NPREDU 

DO  10  IA=1,H 

DO  10  IH=1, NPREDH 

IF  CIC  .EQ.  1)  TEMP  =  DATA(L+l) 

IF  (IC  .EQ.  2)  TEMP  =  DATA(L+2) 

L  =  L  t  2 

RMSdA.IH)  =  TEMP*COH 
10  CONTINUE 

N1  =  NHEAD  +  1 
DO  60  IH=1,N1 

IF  (IH  .GT.  NPREDH)  GO  TO  BO 
Lfi  =  INDXHD(IH) 

JC  =  (IH-1)*2  +  IC 
IF  (.NOT.  LINEAR)  GO  TO  20 
RMSTBL(LH,ITO,IV)  =  RMS(1,IH) 

GO  TO  40 

20  KH  =  INDXRL(IH) 

RLCALC  =  ROLL(K.H,K,IS) 

TP  ^-pLCAl.r  .GF..  RLANG(l))  GO  TO  30 
RMSTBL(LH,ITO,IV)  =  RKS(1,IH) 

GO  TO  40 
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30  IF  (RLCALC  .LE.  BI,AN0(NRANG) )  GO  TO  35 
RMSTBL(LH,ITO,IV)  =  RMS(NRANG .IH) 

GO  TO  40 

35  CALL  SPFIT  (.RLAUG  . RMSC 1 , IH ) .  ELH  , NRANG) 

CALL  SPLVAL  ( RLANG  .  KRAKG  , ELM  , RLCALC ,  RMSTBL(LH ,  ITO  ,  I V )  , DUM ,  lELM  ■> 
40  TOETBL(LH,'ITO,1V)  =  DATA(JC)  +  .6001 
GO  TO  60 

50  JH  =  INPXRI.(IH) 

RMSTBLUH.ITO.IV)  =  RMSTBL(  .IH  ,  ITO  ,  IV ) 

TOETBL(IH,1TO,IV)  =  TOETBL< JH , ITO , IV) 

60  CONTINUE 

100  continue 

IF  (SIGUHdS)  .GT.  SUHMAX)  GO  TO  200 

TOEMIN  =99.0 

TOEMAX  =0.0 

RMSHIN  =  RMSTBLd  ,IT0.1) 

RMSHAX  =  RMSHIN 
DO  120  IV=1,NVK 
DO  110  IH=1.KHEAD 
TEMP  =  RMSTBLdH.ITO.lV) 

VTMP  =  TOETBLCIH.ITO.IV) 

IF  (VTMP  .GT.  99.)  VTMP  =  99. 

IF  (TEMP  .LT.  RMSMIN)  RMSMIN  =  TEMP 

IF  (VTMP  .LT.  TOEMIN)  TOEMIN  =  VTMP 

IF  (VTMP  .GT.  TOEMAX)  TOEMAX  =  VTMP 

IF  (TEMP  .LT.  RMSHAX)  GO  TO  110 

RHSMAX  =  TEMP 
IF  (JR  .EQ.  0)  GO  TO  110 
IF  (iTO  .NE.  IMODL(IS))  GO  TO  110 
IF  (SYMMET  .AND.  IH.GT.13)  GO  TO  110 
MXV  =  IV 
MXH  =  IH 
110  CONTINUE 
120  CONTINUE 

IF  (JR  .EQ.  0)  GO  TO  160 

IF  (ITO  .NE.  IMDDL(IS))  GO  TO  ISO 

RSVTOE(l)  =  MXV 

RSVT0E(2)  =  MXH 

IE  =  2 

DO  130  IV=1,KVK 
DO  130  IH=1,NHEAD 
IE  =  IE  +  1 

RSVTOE(IE)  =  RHSTBLdH.ITO.IV) 

IE  =  IE  +  1 

RSVTOE(IE)  =  TOETBLdH.ITO.IV) 

130  CONTINUE 

•  writ*  to  flevare  motion  fil« 

•  change  lor  VAX/VMS  version 

•  CDC  CALL  WRITKS  (SEVFIL,RSVTOE,IE,IS) 

KRECD  =  NRECD  +  1 

WRITE  (SEVFIL,REC=HRECD)  RSVTOE 

160  CONTINUE 

•  write  to  speed  polar  iile 


ISIGWH  =  SIG«H(IS)*100, 


IF 

(ISIGWH 

■  GE. 

1000) 

WRITE 

(BS,3001) 

ISIGWH 

IF 

(ISIGWH 

.LT. 

1000) 

WRITE 

(BS,3002) 

ISIGWH 

IF 

(ISIGWH 

.LT. 

100) 

WRITE 

(BS,3003) 

ISIGWH 

IF 

(ISIGWH 

■  LT. 

10) 

WRITE 

(BS,3004) 

ISIGWH 

3001  FORMAT  (14) 

3002  FORMAT  (lKC,I3) 

3003  FORMAT  (2H00.I2) 

3004  FORMAT  (3H000,II) 

3000  FORMAT  (IHO.Il) 

3010  FORMAT  (12) 

ITMODL  =  TMDDAL(ITO)  +  .6 

IF  (ITMODL  -LT.  10)  WRITE  (AT, 3000)  ITMODL 
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IF  (ITMODL  .GE.  10)  WRITE  (AT, 3010)  ITMODL 
SUN  IT  =  MET 

IF  (PUNlTS(l)  .NE.  METER)  SUNIT  =  FT 

WRITE  (SEA, 3020)  BS , AT . AC( IC ) , SIGWH( IS) .SUNlT, TMOUALC ITO ) , 

2  ( ACONDd,  1C)  ,1  =  1,3)  ,(STATNM(I)  .1  =  1  ,3) 

3020  FORMAT  (2HBR. A4 , 2A2 , 32H  BRETSCHNEIDER  SEAWAY  -  SIGWH  =,F6.2,A4, 

2  lOH  TMODAL  =.F6.2,7H  SEC,  . 3A4 ,4X . 3A4 .7X) 

WRITE  (SPTFIL.E02S)  PARS, SEA 

6025  FORMAT(AilO) 

WRITE  (SPTFIL,6026)  RMSMIH , RMSMAX .TQEHIN .TOEMAX 

6026  F0RMAT(4F10.6) 

WRITE  (SPDFIL)  ( (RHSTBLCIH , ITO . IV) .IV=1 ,WVK) ,1H=1 ,NHEAD) 

WRITE  (SPDFIL)  ((TOETBL(IH,ITO,IV) ,IV=1,NVK) ,IH=1 .NHEAD) 

200  CONTINUE 

IF  (IT  ,GT.  1  .AND.  VLACPR.EQ.O)  GO  TO  300 
♦  print  RMS/TOE  tables 
DO  250  1PAGE=1  ,2 

IF  (IPAGE.EQ.2  .AND.  SYMHET)  GO  TO  260 
WRITE  (IPRIN.IOOO)  TITLE 
1000  FORMAT  ( IHl , 22X ,20A4) 

IF  (IG  .EQ.  1)  WRITE  (IPRIN.lOlO) 

IF  (IC  .EQ.  2)  WRITE  (IPRIN,1020) 

1010  FORMAT  (/SSX.llHLONGCRESTED) 

1020  FORMAT  (/S8X, 12HSH0RTCRESTED) 

IF  (PUNITS(l)  .HE.  METER)  WRITE  (1PRIN.1030)  SIGWK(IS) 

1030  FORMAT  (45X . 2EHSIGNIFICANT  WAVE  HEIGHT  =.F6.2,5H  FEET) 

IF  (PUNITS(l)  .EQ.  METER)  WRITE  (1PRIN.1031)  SIGUH(IS) 

1031  FORMAT  (45X . 2SHSIGNIFICANT  WAVE  HEIGHT  =,F6.2,7H  METERS) 

IF  (IP.GT.O  .AND.  IM.LE.3)  WRITE  (irRIN.1032)  (PTN AME( 1 . IP ) , 

2  1=1 ,8) .XPTLQC(IP) .YPTLOC(IP) .2PTL0G(1P) 

IF  (IP.GT.O  .AND.  IM.EQ.15)  WRITE  (1PRIN,1032)  (PTNAMECI , IP) , 

2  1=1,8) ,XPTLOC(IP) .YPTLOCdP) .2PTL0C(IP) 

1032  FORMAT  (/27X ,8A4 .2X  ,  6HXFP  = .F7 . 2 ,2X .5HYCL  =.F7 . 2,2X ,BHZBL  =,F7.2) 
IF  (IP.CT.C  .AND.  IH.EQ.e)  WRITE  (IPRTK.IOSS)  (FBNAMEd ,IP) , 

2  1  =  1 ,6)  .XPTFBDdP)  .YPTFEDCIP)  .ZPTFBDdP) 

1033  FORMAT  (/33X,SA4.2X.5HXFP  = ,F7 . 2 ,2X .6HYCL  = ,F7 . 2 , 2X , 5H2BL  =,F7.2) 
IF  (IP.GT.O  .AND,  (IM.GE.IO  -AND.  IK.LE.14))  WRITE  (1PR1N,1073) 

2  XLDSTN(IP) 

1073  FORMAT  (/5eX,7HSTATI0N,F6. 1) 

IF  dM.NE.16)  WRITE  (IPRIN.1034)  RTITL.RTYPE.RUNIT 

1034  FORMAT  (/64X,2A4 , IX , 3A4/B8X ,3A4) 

IF  (IM.EQ.IB)  WRITE  (IPRIN,1036) 

103B  F0RMAT(/B0X.26HH0RIZ0NTAL  FORCE  ESTIMAT0R/5BX,4H  (G)) 

IF  (IM.LT.4  .AND.  IT.EQ.3)  WRITE  dPRlN,1036) 

IF  (IM.EQ.IB)  WRITE  dPRIN,1036) 

1036  FORMAT  (68X , 12H ( ACC .  X  100)) 

IF  (IP.GT.O  .AND.  (IM.GE.IO  .AND.  IM.LE.ll))  WRITE  (IPRIN,1063) 
1063  FORMAT  (/67X, 14H(F0RCE  /  100  )) 

IF  (IP.GT.O  .AND.  (IM.GE.12  .AND.  IH.LE.14))  WRITE  (IPRIN,1065) 
lOGD  FORMAT  (/E4X, 1-H(MQMENT  f  10000)) 

IF  (IM  .Eq.7)  WRITE  (IPRIN.1038) 

1038  FORMAT  (B7X , 14H(F0RCE  /  1000)) 

IF  (IM.NE.IB)  WRITE  (IPRIN . 1040) (STATNH(l) , 1=1 . 3) 

IF  (IM.Eq.lB)  WRITE  (IPRIN, 1041) 

1040  FORMAT  (/40X,3A4.39H  VALUE  /  ENCOUNTERED  MODAL  PERIOD  (TOE)) 

1041  F0RHAT(S1X,42HRMS  VALUE  /  ENCOUNTERED  MODAL  PERIOD  (TOE)) 

IF  (IPAGE  .EQ.  2)  GO  TO  225 

<*  starboard  headings 

WRITE  (IPRIN, 1042)  (HEADNG(IH) ,1H=1 , 13) 

1042  FORMAT  (/68X ,29HSHIP  HEADING  ANCLE  IN  DEGREES/4X , IBV ,2X ,2HT0 ,7X , 
2  4HHEAD,47X,9HSTBD  BEAM,46X,6HF0LlOW/10X,13(6X,I3)) 

DO  220  1V=1,NVK 
IVK  =  VKdV)  +  .BOOl 
WRITE  (AVK,104B)  IVK 
104B  FORMAT  (12) 

WRITE  (IPRIN, 1060) 
iObO  FukHAi  (in  ) 

DO  220  ITO=1,NTMOD 
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210 

1052 


220 


SWHMAX  =  .202■^''TM0DAL(1T0)♦*2 

IF  (PUNITCCl;  .Eq.  METER)  SWHMAX  =  SWHMAX*FTMETR 
IF  ^SIGWHdS)  .GT.  SWHMAX)  GO  TO  220 
IMP  =  TMODAL(ITO)  +  .6001 
DO  210  IH=1,13 

TEMRMS(IH)  =  RKSTBLCiH.irO.IV) 

IF  (IM.EQ.16)  TEMRMS(IH)  =  TEMRMS(IH)  *  100 
IF  (IH.LT.4  .AND.  IT.EQ.3) 

TEMRKS(IH)  =  TEHRMS(IH)  *100  ,  ,  , 

™(Ip!gT^O^°AND.  (IM.GE.12  .AND.  IM.LE.14))  TEMRMS(IH)  = 
rEHRMS(IH)/10000 

TEMTOE(IH)  =  TQETBLCIH.ITO.IV)  ^ 

IF(TEMTOE(IH)  .GT.  99)  TEMT0E(IK)=99 
CONTINUE 

WRITE  (IPRIK,1052)  AVK , IMP . (TEMRMS(IH) ,TEMTOE(IH) , IH=1 , 13) 
FORMAT  (3X,A2,2X,I2,3X, 13(1X,F5.2,1H/,12)) 

AVK  =  BLANK 
CONTINUE 
GO  TO  2B0 


►  port  headings 

225  WRITE  (IPRIN.1043)  (KEADNG(IH) ,IH=14 ,26) 

1043  FORMAT  (/68X:29HSH1P  HEADING  ANGLE  IN  DEGREES/4X . 1HV.2X .2HT0 ,7X . 
2  4HHEAD,47X,9HP0RT  BEAM,46X.6HF0LLQU/10X. 13(6X, 13) ) 

DO  240  IV=1,NVK 
IVK  =  VK(IV)  +  .6001 
WRITE  (AVK, 1046)  IVK 
WRITE  (IPRIN,1060) 

DO  240  ITO=l.NTMnD 

SWHMAX  =  .202*TM0DAL(IT0)**2 

IF  (PUNITS(l)  .EQ.  METER)  SWHMAX  =  SWHMAX*FTMETR 

IF  (SIGWHds!)  .GT.  SWHMAX)  GO  TO  240 

IMP  =  THQDALCITO)  +  .6001 

LH  =  26 

DC  230  IH=1,13 

LH  =  LH  -  1 

TEMRMSdH)  =  RMSTBL(LH,ITO,IV)  ^  ^ 

IF  (IM.Eq.16)  TEMRMSdH)  =  TEHRMS(IH)  *  100 
IF  (dM.LT.4  .OR.  IM.Eq.G)  .AND.  lT.Eq.3) 

2  TEMRMSdH)  =  TEMRMSClH)  •  100  , 

Pr  . 

^  (I«.GE.12  .»»D.  W.LE.M))  TE«B»S(IB)  . 

2  TEMRMSdH)/10000 

TEMTOEdH)  =  TOETBL(LH,ITO,IV) 

IF(TSMTOE(IH)  .GT.  99)  TEMT0E(IH)=99 

^530  CtlNTINHE 

WRITE  (IPRIN,1062)  AVK, IMP. (TEHRMS(IH) .TEMTOEdH) ,1H=1 ,13) 

AVK  =  BLANK 
240  CONTINUE 
260  CONTINUE 
300  CONTINUE 


♦  change  lor  VAX/VMS  version 

♦  CDC  IF  (JR  .Eq.  0)  GO  TO  310 

♦  CDC  CALL  STINDX 

♦  CDC  CALL  WRITMS 

♦  CDC310  CONTINUE 


(SEVFIL .RSINDX .NRSIND) 
(SEVFIL.SWINDX.NSWIND.JR) 


IF  (IM.EQ.8  .AND.  IT.EQ.2)  CALL  DKWSLM  (KR.IC.IM.NPREDR.N.ND^A. 
2  DATA , INDXRL, INDXHL'  .HEADNG ,HDNG, LINEAR, SYMMET .SPINDX ,TOINDX ,IP , 

2  RMSTBL,T0ETBL, RMS, ROLL) 

400  CONTINUE 


change  ior  VAi/VHS  vomiou 
CDC  IF  (ISKPSV  .EQ.  1)  GO  TO  410 
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•  CDC  CALL  STINDX  (SF.VFIL ,  SVIDX  ,  LSVIDX) 

*  CDC  CALL  WRITMS  (SEVI- IL.  RSIMDX .NRSIND , IC) 
t<  CDC410  CONTINUE 

500  CONTINUE 

CLOSE  (UNIT=RMSFIL5 

IF  (ISKPSV  .Eq.  0)  CLOSE  (UNil-SEVFIL) 

CLOSE  (UNIT=SPDFIL} 

CLOSE  (UHIT=SPTF1L) 

IF  (ISKPSV  .EQ.  0)  CALL  SEVKOT  (NSVRSP.RSPNHE.HDNC. IMODL) 

RETURN 

END 

C  DECK  RMSTOE 

SUBROUTINE  RMSTOE 

*  The  purpose  of  the  rmstoe  jegmen-,;  is  to  compute  the  rms ,  second  cind 

•  fourth  moments,  encountev  spectra  ana  associated  periods  of  maximum 

•  spectral  energy  lor  any  ship  lesponse.  The  calculations  are  done 

♦  for  unit  significant  wave  height  in  long  and  shotcrested  seas  for 

♦  a  series  of  modal  wave  periods.  The  shortcrested  calculations  are 

♦  performed  using  a  cosine-squared  weighting  function. 

♦  W.G. MEYERS,  DTNSRDC,  100777 

COMMON  /DATINP/  OPTN ,HaTN ,BSCFIL,VLACPR,RAOPR,RLDMPR,DISPLHT, 

2  LRAOPR , ADRPR , ORGOPTN ,GHN0M ,KG ,STATN (25) ,NS0FST(25 ) , 

2  NLEWF(25),HLFBTH(10,25) ,WTRLNE(10 .25) ,BLEWF(25) ,TLE«F(25) , 

2  AREALF ( 25 ) , NPTLQC , PTNUMB ( 10 ) , PTN ARE , XPTLOC ( 10 ) , YPTLOC (10), 

2  2PTL0C(10) ,NBB.FBNUMB(10) ,FBNAME,XPTFBD(10) ,YPTFBD(10) , 

2  2PTFBD(10) ,FBC0DE(10),FBTYPE,RD0T(10),VKDES,FiJDES, 

2  STATNM,STATIS 

CHARACTER*4  PTNAME(8 , 10) ,FBNAME(8 ,10) ,STATNM(5) ,FBTYPE(3 , 10) 
INTEGER  OPTN, MOTN.BSCFIL.VLACPR.RAOPR, ADRPR, RLDMPR.FBCODE. 

2  FBNUMB, PTNUMB, ORGOPTN 
REAL  KG 

COMMON  /ENVIOR/  VK , NVK , HU , NMU , OMEGA ,H0MEGA , SIGMA , NSIGMA , SIGWH , 

1  KSIGWH .TMODAL , NTMOD , HRANG , RANG ,RLANG . S , NNMU ,FRNUM , VFS 
INTEGER  N VK , NMU . NOMEGA , NSIGMA , NSIGWH , NTMOD , KRAHG , NNMU (8 ) 

REAL  VK(8) ,MU(37,8) ,0HEGA(30) .SIGMA(IO) ,SIGWH(4) ,TM0DAL(8) , 

2  RANG(8) ,RLANG(8),S(30,8) ,FRNUM(8) ,VFS(B) 

COMMON  /GEOM/  X,HrTATN,Y,Z,NaFSET,LPP, BEAM, DRAFT, LCF, 

1  VCG , GM , DELGM , NEBLA ,KPITCH , KROLL , KY AW , KY AWRL , AWP , VCB , FBDX , FBDY , 

2  FBDZ , NFREBD . XPT , YPT , ZPT , NPTS , LCB , GML , ASTAT , BSTAT , TITLE , M ASS , 

2  DISPLM , IPITCH , IRQLL , lYAW , lYAWRL ,CHEAVE , CPITCH , CHEAP I , CROLL , 

2  AREAMX , WSURF , GIRTF .FBDZV , DBLWL , TLCB 

INTEGER  NSTATN,N0FSET(26) , NFREBD, NPTS 
CHARACTER*4  TITLE (20) 

REAL  X(26),Y( 10, 2b), 2(10,26) ,FBDZV(S , lO) .LP? , BEAK .DBLWL , TLCB , 

2  DRAFT , LCF , VCG , CM , DELGM .NEBLA ,KP ITCH , KROiX, KY AW , KY AWRL , AWP . VCB . 

2  FBDX(10),FBDY(10),FBDZ(10),XPT(10) ,YPT(10) ,ZPT(10) ,LCB,GML, 

4  ASTAT(2B) ,BSTAT(26) .MASS, DISPLM, IPITCB.IROLL.IYAW, 

6  I YAWRL , CHEAVE .CPITCH , CHEAPl , CROLL , AREAMX , WSURF , G IRTH ( 25 ) 

COMMON  /INDEX/  PFIDX.LPFIDX.RMIDX.LRMIDX, SVIDX, LSVIDX 

INTEGER  LPFIDX.LRMIDX, LSVIDX 

REAL  PFIDX(236) ,RMIDX(183) ,SVIDX(3) 

COMMON  /lO/  SYSFIL,P0TFIL,C0FFIL,LC0FIL,ICARD,TEXFIL.IPR1H, 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL . SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL , POTFIL , COFFIL .LCOFIL .ICARD .TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL .RAOFIL , RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /PHYSCO/  II .TPI , PI .PIOT, DEGRAD, RADDEG.VKMETR.METRVK.GRAV, 
2  RHO ,  GNU ,  P.K05  RHOF .  GNUS  .  GNUF . FTMETR , PUNITS , REYSCL 
COMPLEX  II 
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REAL  TPI , PI , PIOT , DEGRAD , RADDEG , VKMETR , METRVK , GRAV , RHO , GNU , RHOS , 

1  RH0F,GNUS,GKUF,FTMETR,PUNITS(2) 

COMMON  /RESPN/  NRESP,IPaiNT(l82) .IM0TN(182) ,ITYPE(l82) , 

2  1LIN(182) ,ISYM(182) 

LOGICAL  ILIN.ISYM 

COMMON  /SMPSYS/  FIS , AS , SIS , SOS ,SDS .HALOS , DEV , PRN , SMPPS , SMPIS , 

2  SMPOS . SMPDS , SHPTYPS .SHIPS , VARS , CYCLS .TITLES . OPTION , LSIS , LSOS , 

2  LSDS . LH ALOS , LDEV . LPRN . LSMPPS , LSMPIS . LSMPOS , LSMPDS . LSHPTYPS , 

2  LSHIPS.LTITLES 
CHARACTER* 160  AS 

CHARACTER*80  FIS ,SIS .SOS .SDS .TITLES 

CHARACTER*20  HALOS . DEV . PRN . SMPPS . SMPIS . SMPOS . SMPDS . SHPTYPS 
CHARACTER  SHIPS*6 . VARS*2 .CYCLS*2 
INTEGER*2  OPTION 

COMMON  /STATE/  LAT .VRT .LOADS . ADDRES, SALT. HE AD. EXROLL , BKEEL 
LOGICAL  LAT . VRT . LOADS . ADDRES . S ALT , HEAD . EXROLL, BKEEL 

DIMENSION  WEVN(IOO) ,SPINDX(9) ,T0INDX(9) .DATAC-ISR) , A0HGE(30 , 13) , 
2  R(30) ,RA01(30,8,13) ,RAQ2(30 ,8 . 1 1) ,KREC(13) ,B2(35) 

INTEGER  DELBET 
LOGICAL  LINEAR, SYMMET 
DIMENSION  XID(911) 

EQUIVALENCE  (NRESP.XID) 

KID  =  911 
NWEVN  =  100 

CALL  WEDEFN  (NWEVN, WEVN) 

DELBET  =  16 
NLCH  =  11 

CALL  SCB2  (DELBET, B2, PI, NLCH) 

NPLANE  =  2 
NSFIND  =  KVK  +  1 
NTOIND  =  NTMOD  +  1 

FIS  =  S0S(1;LSDS)//’ .RMS’ 

OPEN  (UNIT=RMSFIL.FILE=FIS ,STATUS= ’UNKNOWN ’ , 

2  ACCESS=’DIRECT’ ,RECL=1760) 

FIS  5  SDS ( 1 : LSDS) // ’  ORG’ 

OPEN  (UNIT=QRGFIL.FILE=FIS ,FQRM= ’UNFORMATTED ’ ,STATUS= ’UNKNOWN ’ ) 

FIS  =  SDS(1;LSDS)//’ .LCO’ 

IF  (LOADS) 

2  OPEN  (UNIT=LCOFIL,FILE=FIS,FORM=’UNFORMATTED’ ,STATUS=’UHKHOWN’) 

*  modified  to  run  on  VAX/VMS 

*  CDC  CALL  WRITMS  (RMSFIL,XID,NID,1) 


WRITE 

(RMSFIL.REC=1) 

(XID( 

I 

,1=1,432) 

WRITE 

(RMSFIL,REC=2) 

(XID( 

I 

.1=433,796) ,NID 

WRITE 

(RMSFIL,REC=3) 

(XIDI 

I 

.1=797,911) 

NRECD  =  3 

DO  60  IR=1,HRESP 
LINEAR  =  ILIN(IR) 

SYMMET  =  ISYM(IR) 

NPREDH  =  13 

IF  (.NOT.  SYMMET)  NPREDH  =  2i 
JA  =  1 

IF  (.NOT.  LINEAR)  JA  =  6 
N  =  1 

IF  (.NOT.  LINEAR)  N  =  NRANG 
IF  (LOADS)  REWIND  LCOFIL 
REWIND  OKGFIL 

READ  (ORGFIL)  TITLE, NVK.NMU.NOMEGA, OMEGA, NRANG, RLANG, VRT, LAT, 
2  ADDRES , LPP , BEAM , DRAFT , D ISPLM , GM , DELGM , KG , KROLL , LCB , GRAV , RHO , 

2  VKDES.VKINC.DBLWL 

♦  define  2-parameter  (significant  wave  height,  modal  wave  period) 
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*  Bretschneider  sea  spectra,  lor  unit  signilicant  wave  height 

DO  600  IT=1,NTM0D 

CALL  BRWVSF  (NQMEGA.l. ,TMQDAL(IT) .OMEGA, S(l, IT)) 

500  CONTINUE 

IPHS  =  0 

NDATA  =  (2  +  N*2)*NPREDH 

*  modilied  lor  VAX/VMS 

*  CDC  CALL  STINDX  (RMSFIL,SPINDX,NSPIND) 

*  CDC  DO  10  I=1,NSPIND 

*  CDC  SPINDX(I)  =  0. 

*  CDC  in  CONTINUE 

DO  60  1V=1,NVK 
NMU  =  HNMU(iV) 

NLCH  =  NMU  -  2 
N1  =  NMU/2  -  1 
N2  =  NMU/2  +  1 
NBETA  =  2*(NMU-1) 

DO  15  IH=1.NMU 
KH  =  IH  -  1 
IF  (IH  .EQ.  1)  KH  =  1 
IF  (IH  .EQ.  13)  KH  =  11 

CALL  RAOPHS  ( AOMGE( 1 , IH) ,RA01 (1 , 1 , IH) ,DUM.RA02( 1 , 1 ,KH) , DUM , 
2  KREC(IH) .IR,IV,IH,IPHS) 

15  CONTINUE 

*  modilied  lor  VAX/VMS 

*  CDC  CALL  STINDX  (RMSFIL.TOINDX.NTOIND) 

*  CDC  DO  20  I=1,NT0IND 

*  CDC  TOINDX(I)  =  0. 

*  CDC  20  CONTINUE 

DO  40  IT=1,NTM0D 

CALL  RMS  (KREC,RA01,RA02, IT, N,R,B2,NPREDH, NLCH, N1,N2, DATA, 
2  IMOTN(IR) .NBETA) 

CALL  TOE  (KREC,A0HGE,RA01,RA02,JA,1T,R,B2,NPREDH, 

2  NLCH , K1 , N2 , NBETA .DELBET , KWEVN , WEVN , IV .DATA) 

*  modilied  lor  VAX/VHS 

*  CDC  CALL  WRITMS  (RMSFIL, DATA, NDATA, IT) 

NRECD  =  NRECD  +  1 
WRITE  ( RMSFIL, REC=NRECD)  DATA 
40  CONTINUE 

*  CDC  CALL  STINDX  (RMSFIL, SPINDX.NSPIND) 

*  CDC  CALL  WRITMS  (RMSFIL.TOINDX.NTOIND, IV) 

60  CONTINUE 

*  CDC  CALL  STINDX  (RMSFIL, RMIDX.LRMIDX) 

KR  =  IR  +  1 

*  CDC  CALL  WRITMS  (RMSFIL, SPINDX.NSPIND.KR) 

60  CONTINUE 

CLOSE  (UNIT=RMSFIL) 

CLOSE  (UNIT=ORGFIL) 

IF  (LOADS)  CLOSE  (UNIT=LCOFIL) 

RETORN 

Emu 

C  DECK  RPHI2D 
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SUBROUTINE  RPHI2D  (K.PHI2D) 

COMMON  /CH3D/  ISIGMA , SIGMIN .GIGMAX .V .SINMU , COSMU , WTSI , 

2  IMHIN,IMMAX,IMDEL,LMIN,LMAX 

REAL  SIGHIN,SIGMAX,V,SINMU,C0SMU,WTSI(4) 

INTEGER  ISIGMA . IHMIN , IMMAX , IMDEL.LHIN ,LMAX 

COMMON  /ENVIOR/  VK .NVK , MU . NMU .OMEGA .NOMEGA , SIGMA , NSIGHA , SIGWH , 

1  NSIGWH , TMODAL, NTMOD , NRANG , RANG , RLANG . S , NNHU . FRNUM , VFS 
INTEGER  NVK, NMU. NOMEGA, NSIGMA, NSIGWH. NTMOD, NRANG. NNMU(8) 

REAL  VK(8) ,MU(37,8) .0MEGA(30) ,SlGMA(lO) ,SIGUH(4) ,TMODAL(8) , 

2  RANG(8) ,RLANG(8) ,S(30,8) ,FRNUM(8) ,VFS(8) 

COMMON  /GEOM/  X.NSTATN.Y.Z.NOFSET.LPP, BEAM, DRAFT, LCF, 

1  VCG . GM , DELGM , NEBLA , KPITCH , KROLL ,KYAW . KYAWRL . AWP , VCB , FBDX . FBDY , 

2  FBDZ . NFREBD , XPT , YPT , ZPT . NPTS ,LCB , GML . ASTAT , BSTAT , TITLE .MASS , 

2  DISPLM . IPITCH , IROLL , lYAW . lYAURL , CHEAVE .CPITCH , CHEAPI , CROLL , 

2  AREAMX , WSURF .GIRTH, FBDZV , DBLWL . TLCB 

INTEGER  NSTATN,NOFSET(2B) .NFREBD, NPTS 
CHARACTER+4  TITLE(20) 

REAL  X(25) .Y(10,2S) ,Z(10,2S) ,FBDZV(8 , 10) , LPP .BEAM .DBLWL .TLCB . 

2  DRAFT ,  LCF ,  VCG  .  GM  .DELGM ,  NEBLA ,  KPITCH  .KROLL ,  KY.AW ,  KYAWRL ,  AWP  ,  VCB  , 
2  FBDX(10),FBDY(10) ,FBDZ(10) .XPT(IO) ,YPT(10) ,2PT( 10 ) , LCB , GML , 

4  ASTAT(25) ,BSTAT(25) .MASS .DISPLM , IPITCH . IROLL , lYAW , 

5  lYAWRL .CHEAVE , CPITCH , CHEAPI , CROLL , AREAMX , WSURF , G IRTH ( 2& ) 

COMMON  /INDEX/  PFIDX,LPFIDX,RMIDX,LRMIDX,SVIDX,LSVIDX 

INTEGER  LPFIDX.LRMIDX.LSVIDX 

REAL  PFIDX(235) .RMIDX(183) .SVIDX(3) 

COMMON  /lO/  SYSFIL,POTFIL,COFFIL.LCOFIL.ICARD,TEXFIL,IPRIN, 

2  SCRFIL , HPLFIL .LRAFIL .ORGFIL , RAQFIL.RMSFIL , SEVFIL . SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL.POTFIL.COFFIL.LCQFIL.ICARD.TEXFIL.IPBIN, 

2  SCRFIL , HPLFIL . LRAFIL , ORGFIL , RAQFIL , RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /STATE/  LAT.VRT. LOADS, ADORES, SALT, HEAD, EXROLL, BKEEL 
LOGICAL  LAT . VRT , LOADS . ADORES . SALT . HEAD , EXROLL , BKEFX 

COMPLEX  PHI2D(10,10,4) 

REAL  DATA(320) 

NNODE  =  NOFSET(K) 

NDATP  =  0 

IF  (VRT)  NDATP  =  16+NNODE 

IF  (LAT)  NDATP  =  NDATP  +  16»NH0DE 

ISIGMX  =  NSIGMA  -  1 

DO  30  ISIGMA=1. ISIGMX 

INDEX  =  (ISIGHA-1)*NSTATN  +  K 

f  modified  lor  VaX/VMS 

♦  CDC  CALL  README  (POTFIL, DATA, NDATP, INDEX) 

READ  (POTFIL, REC=INDEX)  DATA 

NEXT  —  1 

DO  20  J=l. NNODE 

DO  10  I=IMHIN. IMMAX, IMDEL 

PHI2D(ISIGMA.J,I)  -  CMPLX(DATA(NEXT),DATA(NEXT+1)) 

IF  (ISIGMA  -EQ.  ISIGMX)  PHI2D(NSIGMA. J.I)  = 

2  CMPLX(DATA(NEXT+4) ,DATA(HEXT+6) ) 

NEXT  =  NEXT  +  8 
10  CONTINUE 
20  CONTINUE 
30  CONTINUE 

RETURN 

END 

C  DECK  Bcnrvp 

“  “subroutine  RS0LVE(  N,  NDIM,  a,  B.  IP  ) 
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solution  oi  linear  system,  A*X  =  B  , 

INPUT. . . 

H  =  order  ol  matrix. 

NDIH  =  declared  dimension  ol  array  A  . 

A  =  triangularized  matrix  obtained  Irom  "DECOMP". 

B  =  right  hand  vector. 

IP  =  PDVOT  vector  obtained  Irom  "DECOKP". 
do  not  use  solve  il  DECOHP  has  set  IP(N)  =  0  . 

OUTPUT . . . 

B  =  solution  vector,  X  . 

REAL  A,  B,  T 

INTEGER  H,  NDIM ,  IP,  1,  K,  KB.  KHl,  KPl,  M,  NMl 
DIMENSION  A(NDIM,NDIM) ,  B(NDIM) 

DIMENSION  IP(NDIM) 

IF  (N  .EQ.  1)  GO  TO  1500 
NMl  =  N  -  1 
DO  1200  K  =  1.  NMl 
KPl  =  K  +  1 
M  =  IP(K) 

T  =  B(M) 

B(M)  =  B(K) 

B(K)  =  T 

DO  1100  I  =  KPl,  N 
B(I)  =  B(l)  +  A(I,K)*T 
CONTINUE 
CONTINUE 

DO  1400  KB  =  1,  NMl 
KMl  =  N  -  KB 
K  =  KMl  +  1 
B(K)  =  B(K)/A(K,K) 

T  =  -B(K) 

DO  1300  1=1,  KMl 
B(I)  =  B(l)  +  A(I,K)*T 
CONTINUE 
CONTINUE 
CONTINUE 

B(l)  =  B(l)/A(l,l) 

99999  CONTINUE 

;  RETURN 

END 

C  DECK  RSTITL 

SUBROUTINE  RSTITL  (IP,IM,IT,RTITL,RTYPE,RUKIT,PARS) 

COMMON  /DATINP/  OPTN .MOTH .BSCFIL,VLACPR,RAOPR,RLDMPR,DISPLMT , 

2  LRA0PR,ADRPR,0RG0PTN,GMN0M,KG,STATN(25),NS0F3T(25), 

2  NLEWF ( 26 ) , HLPBTH ( 1 0 , 26 ) . WTRLN E ( 1 0 , 25 ) , BLEWF ( 26 ) . TLEWF ( 2 5 ) , 

2  AREALF(2B) ,NPTLOC,PTHUMB(10) ,PTNAME,XPTL0C(10) .YPTLOC(lO) , 

2  ZPTLOCUO) ,NBB,FBNUMB(10),FBNAME,XPTFBD(10),YPTFBD(10), 

2  ZPTFBD(10),FBC0DE(10),FBTYPE,RD0T(10),VKDES,FNDES, 

2  STATNM,STATIS 

CHARACTER*4  PTNAME(8,10) ,FBNAME(8 , 10) ,STATNM(6) ,FBTYPE(3 , 10) 
INTEGER  OPTN . MOTN , BSCFIL , VLACPR , RAOPR , ADRPR , RLDMPR , FBCODE , 

2  FBNUMB,PTNUMB,ORGOPTN 
REAL  KG 

COMMON  /LOADS/  NL0ADS,SWGHT(26) ,SHASS(2B) ,XLDSTN( 10) ,XLDXPT(25) , 
2  LSTATN(2B) 

COMMON  /PHYSCO/  II ,TPI , PI ,PIOT, DEGRAD ,BADDEG ,VKMETR,METRVK ,GRAV , 
2  RHO , GNU , RHOS , RHOF , GNUS , GHUF , FTMETR ,PUNITS , REYSCL 
COMPLEX  II 

CHARACTER*4  P0KITS(2) 

REAL  TPI . PI , PIOT , DEGRAD , RADDEG , VKMETR , METRVK , GRAY , RHO , GNU , RHOS , 

1  RHOF;  GNUS  ,.GNUF,  FTMETR 

CHARACTERfS  PT(IO) .TT(3) ,PPM(3) ,RLT(2) 


♦ 

* 

♦ 

* 

♦ 

* 

* 

♦ 


1100 

1200 


1300 

1400 

1500 


151 


CHARACTER*4  METER,MUNIT(3,7) ,PNTH0T(2,3) ,L0AD(2,5) 
CHARACTER*4  LTYPE(3,2) ,LUNIT(3,3) ,TYPE(3,5) ,RELM0T(2) 
CHARACTER*4  ADRES(2) .ADRTYP(3) ,UNIT(3,7) ,RUNIT(3) 
CHARACTER+4  RTITL(2) .RTYPE(3) .HFEM0T(2) 

CHARACTER'S  PPLM(3) .TTLMC3) .HFEM.HHFEM 
CHARACTER*6  QRGM0T(2,6) 

CHARACTER+10  0M0T(3 ,6)  .FHOTO) 

CHARACTER* 110  PARS 


2 

2 


2 

2 

2 


2 


2 

2 


2 

2 


,*  '/ 

’VERT. ’/ 


’/ 


'  (MET’  ,  ’F.RS/’  .  ’SEC)  ’ 
(DE* . ’G/3E’ , ’C)  ’ 


(DEG’ 


DATA  METER  /’METE’/ 

DATA  MUNIT  /’  (M ’ , ’ETER’ , ’S) 

’(G)’.’  ’ , ’  ( ’ , ’DEG) ’ , ’ 

‘/SEC’, ’2)  (’.’LBS)’.’ 

DATA  PPLM  /’LONG. ’. ’LATE. ’ , 

DATA  HFEM  /’HOR’/ 

DATA  HHFEM  /’H0R2. ’/ 

DATA  TTLM  / ’DISP . ’ , ’ VEL .  ’.’ACC. 

DATA  PT  /’PI ’ , ’P2’ , ’P3’ , ’P4’ , ’PS’ , ’P6’ , ’P7’ . ’P8’ , ’P9’ . ’PIO’/ 
DATA  TT  /’DSP’ , ’VEL’ . ’ACC’/ 

DATA  PPM  /’LON’ . ’LAT’ . ’VER’/ 

DATA  QMOT  /’ SURGE’ ,’ SURVEL ’, ’SURACC ’,’ SWAY ’. ’SWAVEL ’. ’SUAACC ' 
•HEAVE’ , ’HEAVEL’ . ’HEAACC’ , ’ROLL’ . ’ROLVEL’ , ’ROLACC’ , ’PITCH’ , 
’PITVEL’ , ’PITACC’ . ’YAW’ . ’YAWVEL’ , ’YAWACC’/ 

DATA  ORGMQT  /’  S’. ’URGE’.’  ’,’SWAY',’  H’.’EAVE’.’ 

’ROLL’ . ’  P’ . ’ITCH’ . ’  ’ , ’  YAW’/ 

DATA  PNTMOT  /’  LON ’ . ’ GIT . ’ . ’  LAT ’, ’ERAL ’. ’VERT’ .’ ICAL ’ / 

DATA  HFEMQT  /’  HOR’.’IZ.  ’/ 

DATA  FMOT  / ’FINANG ’ , ’FINVEL’ . ’FINACC’ / 

DATA  LOAD  /’  H.S’ , ’HEAR’ . ’  V.S’ . ’HEAR’ , ’  T’ , ’ORS. ’ , ’  V.B’ , 
’END. ■ , ’  H.B’ , ’END. ’/ 

DATA  LTYPE  /’FORC’ , ’E  ’,’  ’, ’HOME’, ’NT  ’,’  ’/ 

DATA  L'JNIT  /’  (T’.’ONS)’,’  ‘ ’  (M- ’ . ’TONS  ’ ,  >  ) 

’-TON’.’S)  ’/ 

DATA  TYPE  /’DISP’ . ’LACE’ , ’MENT’ , ’VELO’ . 'CITY’ 
’LERA’.’TION’.’ANGL’.’E  ’.’  ’.’MOTI’.’ON 
DATA  RLT  /’RLM’ . ’RLV’/ 

DATA  RELMOT  / ’RELA ’ . ’TIVE’/ 

DATA  ADRES  /’  A’.’DDED’/ 

DATA  ADRTYP  /’RESI’ , ’STAN’ , ’CE  ’/ 

DATA  UNIT  /’  (F’.’EET)’,’  ’ , ’ (FEE’ , ’T/SE’ , ’C) 


(FT’ 

’ACCE’ , 
’/ 


’(G) 

’/SEC’ 


’2) 


f:;: 


DEG) 

LBS) 


’,’  (DE’ , ’G/SE’ , ’C) 
’/ 


'(DEG’ 


RUHIT(l)  =  UHIT(1,IT) 

RUNIT(2)  =  UNIT(2,IT) 

RUNIT(3)  =  UHIT(3,IT) 

IF  (PUNITS(l)  .EQ.  METER)  RUNIT(l)  =  H'JNIT(1,IT) 

IF  (PUNITS(l)  .EQ.  METER)  RUNIT(2)  =  MUNIT(2.IT) 

IF  (PUNITS(l)  .EQ.  METER)  RUNIT(3)  =  MUNIT(3,IT) 

JT  =  IT  +  3 

IF  (IP  .GT.  0)  GO  TO  20 


IF  (IM  .GT.  6)  GO  TO  10 


*  origin  motions 

RTITL(l)  =  ORGMOT(l.IM) 

RTITL(2)  =  ORGMOT(2,IM) 

RTYPE(l)  =  TYPEd.IT) 

RTyPE(2)  =  TYPE(2,IT) 

RTYPE(3)  =  TyPE(3,IT) 

IF  (IM.GT.3  .AND.  IT.EQ.l)  RTYPE(l)  =  TYPE(1,4) 

IF  (IM.GT.3  .AND.  IT.EQ.l)  RTYPE(2)  =  TYPE(2,4) 

IF  (IM.GT.3  .AND.  IT.EQ.l)  RTYPE(3)  =  TyPEC3.4) 

IF  (IM  .GT.  3)  RUKIT(l)  =  UNIT(1,JT) 

IF  (IM  .GT.  3)  RUNIT(2)  =  UNIT(2,JT) 

IF  (IM  .GT.  3)  RUNIT(3)  =  UNIT(3,JT) 

IF  (PUNlTS(l)  .EQ.  METER  .AND.  IK  .GT.  3)  RUNIT(l)  =  MUNIT(1,JT) 

IF  (PUNITS(l)  .EQ.  METER  .AND.  IM  .GT.  3)  RUNIT(2)  =  MUNIT(2,JT) 

IF  (PUNITS(l)  .EQ.  METER  .AND.  IM  .GT.  3)  RUNITCS)  =  MUNIT(3,JT) 

WHITE  (PARSjOuOO)  (uHOT(IT,IK) , J-1 ,2) 

3000  FORMAT  (AlO.lOX.AlO.SOX) 
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GO  TO  BO 

10  IF  (IM  .NE.  7)  GO  TO  30 
♦  added  resistance 


RTITL( 

;i) 

1  =  ADRES(l) 

RTITL< 

2) 

1  =  ADRES(2) 

RTYPE( 

;i) 

1  =  ADRTYP(l) 

RTYPE( 

1  =  ADRTYP(2) 

RTYPE( 

!3! 

1  =  ADRTYP(3) 

RUNIT( 

)  =  UNIT(1,7) 

RUNIT( 

2 

)  =  UNIT(2,7) 

RUNITI 

3 

)  =  UNIT(3,7) 

GO  TO  50 

20  IF  (IM  .GT.  3)  GO  TO  30 


motions  at  a  point 

RTlTL(l)  =  PNTMOTCl.IM) 
RTITL(2)  =  PNTMgT(2j^IM) 


3010 


RTYPE(l)  =  TYPE(1,IT) 

RTYPEC2)  =  TYPE(2,IT) 

writ!  (pars'!3010)‘ppm(im) ,TT(IT) ,PT(IP) ,PPLM(IM) ,TTLM(IT)  , 
XPTLOCaP)  .YPTL0C(IP).ZPTL0C(IP) 

FORMAT  (3A3,11X,AB.1X,A5,4X,2HAT,4X,6HXFP  =,F6.2,3X,5HYCL 
F7.2,3X,5HZBL  =,F7.2.28X) 

GO  TO  60 


30  IF  (IM  .NE.  8)  GO  TO  60 


relative  motion 

RTITL(l)  =  RELMaT(l) 
RTITL(2)  =  RELM0T(2)^ 
RTYPEU)  =  TYPE(1,IT) 
RTYPE(2)  =  TYPE(2,IT) 
RTyPE(3)  =  TYPE(3,IT) 
IF  (IT  .EQ.  1)  RTYPE(1 

IF  (IT  .Eq.  l)  RTYPE(2 

IF  (IT  .EQ,  1)  RTYPE(3 


3020 


=  TYPE(1,S) 

=  TYPE(2,6) 

FOBHJT  (2A3!i«!“m!1x.3A4,2HAI.«.6HXFP  •  ,F6. 2.3A .EBYCL  •. 
F7.2,3X.6HZBL  =,F7.2.22X) 


60  IF  (IM  .HE.  9)  GO  TO  72 


*  anti-roll  fins 


RTITL(l)  =  ’ 
RTITL(2)  =  ’ 


IF 

IF 


(IT 

(IT 


FIH’ 

JT  =  4 
JT  =  IT 


•EQ.  1) 

.GT.  1) 

DO  60  1=1,3 
60  RTYPE(I)  =  TYPEd.JT) 

JT  =  IT  +  3 
DO  70  1=1,3 

70  RUNIT(I)  =  UHITd.JT)  ^  ^ 

WRITE  (PARS, 3000)  FMOT(IT) ,FMOT(IT) 


72  IF  (IM  .HE.  15)  GO  TO  80 
RTITL(l)  =  HFEMOT(l) 
RTITL(2)  =  HFEM0T(2) 
RTYPe(i)  =  TYPE(1,3) 
RTYPE(2)  =  TYPE(2,3) 
RTYPE(3)  =  TYPE(3,3) 
RUNIT(l)  =  UHIT(i,3) 

-  niiTT/O 

RUKIT(3)  =  0HIT(3,3) 


153 


WRITE  (.PARS, 3010)  HFEM  .TT(3)  ,PT(IP)  ,HHFEM,TTLMC3)  . 

2  XPTLOCUP)  .YPTLOCdP)  ,ZPTLQC(IP) 

80  IF  (.HOT.  (IP.GT.0.AHD.(IM.GE.10.AHD.1M.LE.14)))  GO  TO  100 

*  loads 

JM  =  IH  -  9 
RTITL(l)  =  L0AD(1,JM) 

RTITL(2)  =  LQAD(2dH) 

LT  =  1 

IF  (IM  .GT.  11)  LT  =  2 
MT  =  LT 

IF  (LT.Eq.2. AKD. (PUNITS(l) .NE.METER))  MT  =  3 

DO  82  1=1,3 

RTYPE(l)  =  LTYPEd.LT) 

RUHITCI)  =  LUNITd.MT) 

82  CONTINUE 

IF  (JM  -EQ.  1)  WRITE  (PARS. 3031)  PTCIP) .XLDSTNCIP) 

IF  (JH  .EQ.  2)  WRITE  (PARS, 3032)  PTdP)  .XLDSTN(IP) 

IF  (JM  -EQ.  3)  WRITE  (PARS, 3033)  PT(IP) .XLDSTN ( IP) 

IF  (JM  .EQ.  4)  WRITE  (PARS, 3034)  PT(IP) , XLDSTN ( IP) 

IF  (JM  .EQ.  B)  WRITE  (PARS, 3035)  PT(IP) ,XLDSTN(IP) 

3031  FORHAT(6HHSHEAR.A3,11X,29HHORIZ.  SHEAR  FORCE  AT  STAT ION ,F6 .2 . S5X ) 

3032  F0RMAT(6HVSKEAR,A3.11X,29HVERT.  SHEAR  FORCE  AT  STATION ,F6 . 2 , 55X ) 

3033  F0RMAT(4HTM0M,  A3 i 13X ,29HT0RS10NAL  MOMENT  AT  STATION, F6. 2, S5X) 

3034  F0RMAT(4HVM0M,  A3 , 13X , 29HVERT .  BEND.  MOM.  AT  STATION .F6 . 2 , 55X) 

3035  FORMAT (4HHM0M,  A3 , 13X , 29HH0RIZ.  BEND.  MOM.  AT  STATION ,F6 .2 , 65X) 

100  CONTINUE 

RETURN 

END 

C  DECK  RVSLAT 

SUBROUTINE  RVSLAT  (VCG.MQTLG.MOTL) 

CUMHLEX  hOTLG(3) ,H0TL(3) 

MOTL(l)  =  MOTLG(l)  +  VCG*M0TLG(2) 

M0TL(2)  =  M0TLG(2) 

M0TL(3)  =  M0TLG(3) 

RETURN 

END 


C  DECK  SBEDDY 

SUBROUTINE  SBEDDY 

COMMON  /APPEND/  NBKSET,HBKSTN(2) ,BKIMAG(2) ,BKFS(2) ,BKAS(2) , 

2  BKWD ( 2 ) , BKSTN ( 1 0 , 2 ) , BKHB ( 1 0 , 2) , BKLNTH , BKWDTH , 

2  BKWL(10,2) ,BKAK(10,2) ,NSKSET,SKIMAG(2) .SKFLS(2) ,SKALS(2) , 

2  SKAUS(2) ,SKHB(2),SKFLWL(2) ,SKALWL(2) ,SKAUVL(2) ,NPDSET,RDIMAG(2) , 

2  RDRFS(2) ,RDRAS(2),RDRHB(2) ,RDRFWL(2) , RDRAWL(2) ,RLTFS(2) ,RDTAS(2), 
2  RDTHB(2),RDTFWL(2),RDTAWL(2),NSBSET,SBIMAG(2),SQBRFS(2) ,S0BRAS(2) 
2,S0BRHB(2) ,S0BRFW(2) .S0BRAW(2) .SIBRFS(2) ,SIBRAS(2) ,SIBRHB(2) , 

2  SIBRFW(2) .S1BRAW(2) .SBTFS(2) ,SBTAS(2) .SBTHB(2) ,SBTFWL(2) , 

2  SBTAUL(2) ,NFBSET,FNIMAG(2) ,FNRFS(2) ,FNRAS(2) , 

2  FKRHB(2),FNRFWL(2),FNRAWL(2) ,FHTFS(2) .FNTAS(2) ,FNTKB(2) , 

2  FHTFWL(2) ,FNTAVL(2) ,NEXPRD,ENRD0(8) ,ENRDS(8) 

COMMON  /CH3D/  ISIGMA,SIGMIN,SIGMAX,V,SIHMU,COSMU,WTSI, 

2  IMMIN,INNAX,IHDEL,LMIN,LHAX 

REAL  SIGHIN.SIGMAX,V,SINMU,C0SMU,WTSI(4) 

INTEGER  ISIGMA , IMMIN , IMMAX , IMDEL , LHIN , LMAX 

COMMON  /ENVIOR/  VK ,NVK , MU, NMU .OMEGA .NOMEGA .SIGMA .NSIGMA . SIGWH , 

1  NSIGWH .TMODAL , NTMOD , NRANG .RANG , RLANG . S . NNMU , FRNUM , VFS 
INTEGER  HVK , NMU , NOMEGA , NSIGMA .NSIGWH , NTMOD , NRANG , NNMU(8 ) 

REAL  VK(8) ,MU(37,8) ,0MEGA(30) ,SIGMA(10) ,SIGWH(4) ,TM0DAL(8) , 

2  RaSG(S),RLASG(D)  ,S(30,S).FP.SUM(S),VFS(S) 


COMMON  /PHYSCO/  II ,TP1 , PI , PIQT .DECRAD .RADDEG , VKMETR , METRVK , GRAY  , 

2  RHO , GNU , RHOS , RHOF .GNUS . GNUF .FTMETR .PUNITS , REYSCL 
COHPI FX  IT 

CHARACTER^A  PUNITS(2) 

REAL  TPI, PI, PIOT, DEGRAD, RADDEG. VKMETR. METRVK, GRAY, RHO, GNU. RHOS, 

1  RHOF, GNUS, GNUF, FTMETR 

COMMON  /RLDEK/  PSURI25) .EMK(25) .DK(2E) .CAK(2B) , HQ .HSPAN , HMNCHD . 

2  HAREA,HXCP,HYCP,HZCP,HGAMMA,HYHAT,HEAR,HLCS,RQ(2) ,RSPAN(2) , 

2  RMNCHD(2) .RAREA(2) ,RXCP(2) ,RYCP(2) ,RZCP(2) , RGAHHA(2 ) , RYHAT(2) , 

2  REAR(2) ,RLCS(2) ,SQ(2) ,SSPAN (2) , SMNCHD(2) , SAREA ( 2)  ,SXCP(2)  , 

2  SYCP(2),SZCP(2)  ,SGAMMA(2).SYHAT(2),SEAR(2),SLCS(2),BQ(2) , 

2  BSPAN(2) ,BMNCHD{2) .BAREA(2) ,BXCP(2) .BYCP(2) ,B2CP(2) ,BGAMMA(2) , 

2  BYHAT(2) ,BEAR(2) .BLCS(2) .Fq(2) ,FSPAN(2) .FMNCHD(2) ,FAREA(2). 

2  FXCP(2) ,FYCP(2) ,FZCP(2) .FGAMMA{2) .FYHAT(2) ,FEAR(2) ,FLCS(2) , 

2  PQ(2,2) ,P3PAN(2,2) .PMNCHD(2 , 2) . PAREA(2 ,2) , PXCP(2 . 2} ,PYCP(2.2) , 

2  PZCP(2,2),PGAMMA(2,2) , PYHAT(2 ,2) , PEAR(2 ,2) , PLCS ( 2 . 2) , 

2  STADMP(IO) ,SHPDHP(10,8) .ENCON ,WPHI ,TPHI ,WMELM(4 ,9) ,SFELM(4 ,9 ,8)  , 

2  REELN(4,9,8) ,PEELM(4 , S , 8 ) . FEELM(4 .9 , 8) ,HEELM(4 , 9 , B) , BEELM (4 . 9 , 8 ) , 
2  ENWM,ENSFI8,8) ,ENRE(8) .ENPE(8) .ENFE(8) ,E::HE( 8) , ENBE(8 ) , 

2  ENEMV(8,8) ,ENRL(8) .ENPL(8) ,ENFL(8) ,ENHL(8) .ENSL(8) ,ENBL(8) , 

2  ENSHP(8.8) ,RELH(4,9) ,ITS(25) ,RD(25) ,EDDY(8,2S) ,RGB(25) 

REAL  RDBLK(2692) 

EQUIVALENCE  (PSUR( 1 ) , RDBLK( 1 ) ) 

DO  20  IA=1.KRANG 
ENPE(IA)  =  0 
DO  10  IS=1,NSIGMA 
SHPDMP(IS.IA)  =  0 
10  CONTINUE 
20  CONTINUE 

IF  (NSBSET  .EQ.  0)  GO  TO  100 
DO  60  Ksl, NSBSET 
DO  50  L=l,2 

IF  (L.EQ.2  .AND.  SBTHB(K) .EQ .0. )  GO  TO  50 
YUAT  =  SQRT(PYCP(K,L).*2  +  P2CP(K,L)**2) 

GAMMAE  =  PGAMMA(K,L)  +  1. 

ALF  =  ATAN(  ABS(  ( (PYCP(K,L)/PZCP(K,L) )  +  TAN(GAMMAE*DEGRAD) )  / 

2  (1.  -  (PYCP(K,L)/P2CP(K,L))*TAN(GANMAE*DEGRAD))  )  ) 

C  =  0.0065  ♦  (PLCS(K,L)**2)/(0.9*PI*PEAR(K,L)) 

CON  =  PQ(K,L)*4./(3.*PI)*RH0*YHAT**3  ♦  PAREACK.D^C+SIHCALF) 

DO  40  IA=1.NRANG 
DO  30  IS=1,NSIGMA 

SHPDMPdS.lA)  =  SHPDMP(IS.IA)  +  {CON*SIGMA(IS)*RANG(IA) )  * 

2  SIGMA(IS) 

30  CONTINUE 
40  CONTINUE 
50  CONTINUE 
60  CONTINUE 

DO  70  IA=1,NRANG 

CALL  SPFIT  (SIGMA, SHPDMP(1,1A).PEELM(1,1TA),NSIGMA> 

ENPE(IA)  =  EHC0N*REVAL(PEELH(1,ISIGMA.IA).WTSI) 

70  CONTINUE 
100  CONTINUE 

RETURN 

END 

C  DECK  SBLIFT 

SUBROUTINE  SBLIFT 

COMMON  /APPEND/  iBKSET,IBKSTN(2) ,BKIHAG(2) ,BKFS(2) ,BKAS(2) , 

2  BKWD(2) ,BKSTN(10,2) ,BKHB(10.2) .BKLNTH.BKWDTH, 

2  BKWL(10,2) ,BKAN(10,2) .NSKSET,SKIMAG(2) .SKFLS(2) .SKALS(2) , 

2  SKAUS(2),SKHB(2),SKFLWL(2) ,SKALWL(2) ,SKAUWL(2) ,NRDSET.RDIMAG(2) , 

2  RDRFS(2) ,RDRAS(2),RDRHB(2) ,RDRFUL(2) .RDRAWLC^) ,RDTFS(2) ,RDTAS(2), 
2  IU)THB(2), RDTFWL(2),RDTAWL(2), NSBSET, SBIMAG(2),S0BRFS(2KS0BRAG (2) 
2,S0BRHB(2) ,S0BRFW(2) ,S0BRAW(2) ,SIBRFS(2) ,SIBRAS(2) ,SIBRHB(2> , 

2  SIBRFW(2) ,SIBRAW(2) ,SBTFS(2) ,SETAS(2) ,SBTHB(2) ,SBTFWL(2) , 

2  SD'l'AWLl 2 }  .NrnStiX , rnIHAG (2)  ,FKnFS(2 )  ,FnRAS(2)  , 

2  FNRHB{2),FNRFWL(2),FKRAWL(2) ,FNTFS(2) ,FHTAS(2) ,FNTHB(2). 

2  FKTFWLC2) ,FNTAWL(2) ,NEXPRD,ENRD0(8) ,ENRDS(8) 
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COMMON  /ENVIOR/  VK , NVK , MU ,NMU .OMEGA , NOMEGA .SIGMA .NSIGMA . SIGWH , 

1  HSIGWH.TMODAL.KTMOD.NRANG.RAKG.RLANG.S.NNHU.FRNUM.VFS 
INTEGER  NVK, NHU, NOMEGA, NSIGMA, NSIGWH,NTM0D,NRANG,NNMU(8) 

REAL  VK(8) ,MU(37,e) ,0MEGA{30) ,SIGHA( 10) ,SIGUH(4 ) .TM0DAL(8) , 

2  RANG(8) ,RLANG(8), 5(30,8) ,FRNUM(8) .VFS(8) 

COMMON  /GEOM/  X .NSTATN , Y ,Z .NOFSET .LPP , BEAM.DRAFT .LCF , 

1  VCG , GM ,DELGM , NEBLA . KPITCH ,KROLL . KYAW , KY AWRL , AWP , VCB , FBDX , FBDY , 

2  FBD2,NFREBD.XPT,YPT,ZPT,NPTS,LCB,GML,ASTAT.BSTAT, TITLE. MASS, 

2  DISPLM , IPITCH . I  ROLL , lY AW , lYAWRL , CHEAVE , CPITCH . CHEAFI , CROLL , 

2  ArtEAHX .WSURF , GIRTH . FBDZV ,DBLWL,TLCB 

INTEGER  NSTATN ,NQFSET(25) .NFREBD.NPTS 
CHARACTER*4  TITLE(20) 

REAL  X(25) ,Y(10,2&) ,Z(10,25) ,FEDZV(8,10) .LPP .BEAM .DBLUL ,TLCB , 

2  DRAFT , LCF , VCG , GM .DELGM , NEBLA , KPITCH .KROLL , KY AW , KYAWRL , AWP , VCB , 

2  FBDX(10),FBDY(10) ,FBDZ(10) .XPT(IO) , YPT( 10) , ZPT( 1 0 ) ,LCB , GML , 

4  ASTAT(25) ,BSTAT(26) , HASS .DISPLM , IPITCH , IROLL , lYAV . 

5  lYAURL, CHEAVE, CPITCH, CHEAPI, CROLL, AREAMX, WSURF, G1RTH(2S) 

COMMON  /PHYSCO/  I I , TPI . PI , PIOT . DEGRAD , RADDEG . VKHETR , METRVK , GRAV , 

2  RHO  ,  GNU  ,  RHOS  ,  RHOF .  GNUS  ,  GIJUF  .FTMETR ,  PUN  ITS ,  REYSCL 
COMPLEX  II 

CHARACTER*4  PUNITS(2) 

REAL  TPI ,PI , PIOT, DEGRAD, RADDEG. VKMETR, METRVK, GRAV, RHO, GNU. RHOS, 

1  RHOF. GNUS, GNUF, FTMETR 

COMMON  /RLDEK/  PSUR(26) ,BMK(25) ,DK(25) ,CAK(2S) .HQ .HSPAN .HMNCHD , 

2  HAREA,HXCP,HYCP,H2CP.HGAMMA.HYHAT,HEAR,HLCS,RQ(2) ,RSPAN(2) , 

2  RMNCHD(2) ,RAREA(2) .RXCP(2) ,RYCP(2) ,RZCP(2) ,RGAMMA(2) ,RYHAT(2) , 

2  REAR(2) ,RLCS(2) . SQ (2) , SSPAN f 2) , SMNCHD(2) , SAREA (2) , SXCP(2 ) , 

2  SYCP(2),S2CP(2) ,SGAMMA(2) .SYHAT(2) ,SEAR(2) ,SLCS(2)  , BQ(2) , 

2  BSPAN(2) .BMNCHD(2) ,BAREA(2) ,BXCP(2) ,BYCP(2) .BZCP(2) ,BGAMHA(2) , 

2  BYHAT(2) ,EEAR(2) ,BLCS(2) ,FQ(2) ,PSPAN(2) .FMNCHD(2) ,FAREA(2) , 

2  FXCP(2) ,FYCP(2) ,FZCP(2) ,FGAMMA(2) ,FYHAT(2) .FEAR(2) ,FLCS(2) , 

2  Pq(2,2),PSPAK(2.2) .PMNCHD(2 ,2) .PAREA(2 .2) ,PXCP(2 , 2  I ,PY0P(2 ,2) , 

2  PZCP(2,2),PGAMMA(2,2),PYHAT(2,2) .PEAR(2,2) .PLCS(2,2) . 

2  STADMP(IO) ,SHPDMP(10,8) .ENCON ,WPHI ,TPHI ,WMELM(4 ,9) ,SFELM(4 ,9 , 8) , 

2  REELM(4,9,8),PEELM(4,9,8) .FEELM(4,9,8) ,HEELM(4.9,8) ,BEELM(4,9,8) , 
2  ENWM,ENSF(8.8) ,ENRE(8) .EHPE(8) ,ENFE(8) ,ENHE(8) ,ENBE(8) , 

2  ENEMV(8 .8) ,ENRL(8) ,ENPL(8) ,ENFL(8) ,ENHL(8) .ENSL(8) ,ENBL(8) , 

2  ENSHP(8,8) ,RELM(4,9) ,ITS(26) .RD(25) .EDDY(8,25) ,RGB(26) 

REAL  RDBLK(2692) 

EQUIVALENCE  (PSUR(l) ,RDBLK(1)) 

REAL  LCS.MCHORD 

IF  (HSBSET  .EQ.  0)  GO  TO  60 
EN  =  0 

STASPC  =  LPP/20 
DO  BO  K=1.NSBSET 
DO  40  L=l,2 

IF  (L.EQ.2  .AND.  SBTHB(K) .EQ . 0 . )  GO  TO  40 
IF  (L  .EQ.  2)  GO  TO  20 

outer  brackets 

XRTF  =  LCB  -  SOBRFS(K)*STASPC 
XRTA  =  LCB  -  S0BRA3(K)*STASPC 
XTPF  =  LCB  -  SBTFS(K) ♦STASPC 
XTPA  =  LCB  -  SBTAS(K)^STASPC 
YRT  =  SOBRHE(K) 

YTP  s  SBTHB(K) 

ZRT  =  (SOBRFW(K)  +  S0BRAW(K))/2  -  (DBLUL+VCG) 

ZTP  =  (SBTFWL(K)  +  SBTAWL(K))/2  -  (DBLWL+VCG) 

GO  TO  30 

iivner  bracket 

0  XP.TF  "  LCE  -  •STASPC 

XRTA  =  LCB  -  siBRAS(k)^STASPC 
YRT  =  SIBRHB(K) 
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ZRT  =  (SIBRFW(K)  +  SIBRAW(K))/2  -  (DBLWL+VCG) 
30  CONTINUE 

RCHORD  =  XRTF  -  XRTA 
TCHORD  =  XTPF  -  XTPA 

SPAN  =  SqRT((ZRT-ZTP)**2  +  (YTP-YRT)**2) 

Q  =  2 

HCHORD  -  0.6*((XRTF-XRTA)  +  (XTPF-XTPA)) 

♦  area 

AREA  =  SPAN*MCHQRD 

♦  center  of  pressure 

ZP  =  0.5*(ZRT+2TP) 

YP  =  0.5*(YRT  +  YTP) 

XO  =  C.5*(XRTF  +  XTPF) 

XCP  =  XO  -  0.2B*MCH0RD 
YCP  =  YP 
ZCP  =  ZP 


*  moment  arn 

ARC  =  (ZRT-ZTF)  /  SPAN 
GAMMA  =  -  90 

IF  (ARG  .LT.  1)  GAMMA  =  -  ASIN(ARG)*RADDEG 

IF  (L  .EQ.  1)  GAMMA  =  -  GAMMA 

GAM  =  GAMMA*DEGRAD 

YHAT  =  YCP*COS(GAM)  +  ZCP*SIN(GAM) 

*  effective  aspect  ratio 

EAR  =  2*SPAN/MCHQRD 

■*  lift  curve  slope 

LCS  =  2*PI 
PQ(K.L)  =  Q 
PSPAN(K.L)  =  SPAN 
PMNCHD(K,L)  =  HCHORB 
PAREA(K,L)  =  AREA 
PXCF(K,L)  =  XCP 
PYCP(K,L)  =  YCP 
PZCP(K,L)  --  ZCP 
PGAMMA(K,L)  =  GAMMA 
PYHATCK.L)  =  YHAT 
PEAR(K,L)  K  EAR 
PLCSCK  L)  =  LCS 

EN  =  EN  +  Q*(RH0/2)'>AREA*LCS*YHAT*YHATeWPHI*E»CON 
40  CONTINUE 
60  CONTINUE 
60  CONTINUE 

DO  70  IV=1,NVK 
ENPL(IV)  =  0 

IF  (NSBSET  .GT.  0)  ENPL(IV)  =  EN*VFS(IV) 

70  CONTINUE 

RETURN 

END 

C  DECK  SCB2 

SUBROUTINE  SCB2  (DELHDG,B2,PI.HLCH) 


*  This  routine  pro-computes  the  shortcrested  weighting 

*  constants,  E2.  for  variable  spreading  angles. 

*  N.G. MEYERS,  DTNSRDC,  072977 

INTEGER  DELHDG 
DIMENSION  B2(NLCH) 

N  =  180/(2*DELHDG) 

CONI  =  l./N 
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C0N2  =  P1/(2*N) 

I  =  -  N 

DO  10  K=1,MLCH 
1  =  1  +  1 

COSI  =  C0S(I*C0N2) 

B2(K)  =  com+cosi+cosi 

10  CONTINUE 

RETURN 

END 


C  DECK  SECTl 

SUBROUTINE  SECTl 

*  d«terinin«6  s«ction  type  (ITSK)  and  bilge  radius  (RDK) 

*  ITSK  =  1  bow  sections  ~  narrow  v  or  u 

*  ITSK  =  2  lull  sections 

*  ITSK  =  3  shallow  v  or  u  (destroyer  stern) 

*  ITSK  =  4  very  rounded  destroyer  midship  section  -  no  eddymaking 

COMMON  /APPEND/  NBKSET , NBKSTN (2) , BKIMAG(2) , BKFS(2) , BKAS(2 ) , 

2  BKUD(2) .BKSTN(10,2) ,BKHB(10 ,2) .BKLNTH , BKWDTH . 

2  BKUL(10,2) ,BKAN(10,2) .N3KSET.SKIMAG(2) .SKFLS(2) ,SKALS(2) , 

2  SKAUS(2) ,SKHB(2),SKFLWL(2) ,SKALUL(2) .SKAUWL(2) , NKDSET .RDIMAG ( 2 ) . 

2  RDRFS(2).RDRAS(2),RDRHB(2) , RDRFUL{2) . RDRAWL(2) , RDTFS (2) , RDTAS (2 ) . 
2  RDTHB(2;,RDTFWL(2),RDTAWL(2),NSBSET.SBIMAG(2) .S0BRFS(2) ,S0BRAS(2) 
2.S0BRHB(2) ,S0BRFW(2) ,S0BRAW(2) ,SIBRFS(2) .SIBRAS(2) .STBRriB(2) . 

2  SIERFW(2) .SIBRAW(2) ,SBTFS(2) .SBTAS(2) .SBTHB(2) .SBTFUL(2) , 

2  SBTAWL(2) ,KFNSET,FN1MAG(2) ,FKRFS(2) ,FNRAS(2) , 

2  FNRHB(2) ,FNRFWL(2) ,FNRAWL(2) ,FNTFS(2) ,FNTAS(2) ,FNTHB(2) , 

2  FNTFUL(2) .FNTAWL(2) .NEXPRD ,ENRD0(8) ,ENRDS(8) 

COMMON  /DATINP/  OPTN .MOTN , BSCFIL , VLACPR .RAOPR.RLDMPR .DISFLMT . 

2  LRA0PR.ADRPR,0RG0PTN.GMN0H,KG,STATN(2b) ,NS0FST(25), 

2  NLEWF(25),HLFBTH(10.25) .WTRLNE(10 ,25) ,BLEWF(25) ,TLEWF(25) . 

2  ARCALr(2E) ,}JrTL0C,PTNUMS(10) ,PTNAME,XPTIOC(10) .YPTLOC(IO) . 

2  ZPTLOC(IO) ,NBB.FBNUHB(10).FBNAKE,XPTFBD(10),YrTFBD(10) , 

2  2PTFBD(10) ,FBCQDE<10),FBTYPE,RD0T(10),VKDES,FNDES, 

2  STATNM.STATIS 

CHARACTER+4  PTNAME(8 . 10) ,FBNAHE(8 , 10) ,STATNM(5) , FBTYPEO , 10) 
INTEGER  OPTN. MOTN, BSCFIL, VLACPR, RAOPR.ADRPR.RLDHPR.FBCODE, 

2  FBNUHB.PTNUMB,ORaOPTK 
REAL  KG 


COMMON  /GEOM/  X , NSTATN .Y ,Z .NOFSET ,LPP , BEAM .DRAFT ,LCF , 

VCG , GM .DELGM , NEBLA , KPITCH . KROLL , KYAW .KYAWRL . AVP , VCB , FBDX ,FBDY , 
FBDZ , NFREBD , XPT , YPT , ZPT , NPT3 , LCB . GML , ASTAT , BSTAT , TITLE , M ASS , 
DISPLM,1PITCH,IR0LL,IYAW,IYAWRL.CHEAVE,CPITCH.CHEAPI,CR0LL, 

ARE AMX . WSURF .GIRTH . FBDZV .DBLWL .TLCB 
INTEGER  NSTATN, K0FSET(26), NFREBD, KPTS 
CHARACTER*4  TITLE(20) 

REAL  X(26) ,Y(10.26) ,Z(lO,26) .FBDZVfB , 10) ,LPP .BEAM .DBLWL, TLCB , 
DRAFT , LCF , VCG , GM, DELGM , NEBLA , KPITCH , KROLL, KYAW , KYAWRL , AWP , VCB , 
FBDX(IO) ,FBDY(10) ,FBDZ(10) ,XPT(10) ,YPT(10) .ZPKlO) ,LCB,GML, 
ASTAT(2S ) , BSTAT(26 ) . MASS .DISPLM , IPITCH , IROLL , lYAW . 
lYAWRL , CHEAVE , CPITCH , CHEAPI , CROLL. AREAMX .WSURF , GIRTH  C25 ) 


COMMON  /lO/  SYSFIL,POTFIL,COFFIL,LCOFIL,ICARD,TEXFIL.IPR1N. 
2  SCRFIL . HPLFIL , LRAFIL , ORGFIL , RAOFIL.RMSFIL , SEVFIL , SPDFIL . 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL,POTF1L,COFFIL,LCOF1L,ICARD,TEXFIL.IPRIN, 
2  SCRFIL, HPLFIL, LRAFIL, ORGFIL, RAOFIL.RMSFIL, SEVFIL, SPDFIL, 

2  SPTFIL.LACFIL.LAEFIL 


COMMON  /RLDBK/  PSUR(26) ,BMK(25) ,DK(25) ,CAK(25) , HQ.HSPAN .HMNCHD . 
2  HAREA,HXCP,HyCP,HZCP,HGAMMA.HYHAT,HEAR.HLCS,RQ(2) ,RSPAH(2) , 

2  RMNCHD(2) ,RABEA(2) ,RXCP(2) .RYCP(25 ,RZCP(2) .RGAHMA(2) ,RYHAT(2) , 

2  REAR(2) ,RLCS(2) ,SQ(2) ,SSPAN(2) ,SMNCHD(2) ,SAREA(2) ,SXCP(2) , 

2  SYCP(2),SZCP(2) .SGAMMA(2) ,SYHAT(2) ,SEAR(2) , SLCS(2) ,  B0(2 ) , 

2  BSPAN(2),BMNCHD(2) ,BAREA.(2) ,BXCP(2) ,BYCP(2) ,BZCP(25 ,BGAMMA(2) , 

2  uYt) AT  ( 2 ;  ,  BEAR ( 2 )  , BLC3 ( 2 ) , FQ ( 2 ) , rSP AS ( 2 )  .FMKCHD ( 2 )  , F .A P F i  (  2 1 , 

2  FXCP(2),FYCP(2),F2CP(2),FGAMMA(2).FYHAT(2),FEAR(2),FLCS(2) , 
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FQ(2  2)  PSPAN(2,2) ,PMNCHD(2,2),rAREA(2,2),FXCP(2,2)  PYCP(2,2^ , 
PZCP(2,2),PGAMMA(2.2).PYHAT(2,2) ,PEAR(2,2) .PLCf.(2.25 . 

STADMPdo)  .SHPDMP(10,8)  .ENCQN  .WPHI  .TPHl  .WMELM(4 , 9 ) ,  SI  ELM  ( 4 , 9 , 8 )  , 
REELM(.4 .9 ,8)  ,PEELM(4  ,9 ,8)  ,FEEl.M(4  ,9,8)  ,HEELM(4  .9,6)  , BEELM(4 , 9 , 8  ) 
ENUH,ENSF(8,8) ,ENRE(8) ,ENPE(6) .ENFE(8) ,ENHE(e) ,ENBE(8) , 
ENEMV(8,e) ,ENRL(;b),ENPL(8),ENFL(8)  ENHL(8) ,ENSL(6)  ENBL(8) . 
ENSHP(8 ,8) ,RELM(4 ,9) , ITS ( 25 ) , RD(25) , EDDY (6, 25) .RGB (25) 

REAL  RDBLK{2692) 

EQUIVALENCE  (PSURC 1 ) .RDBLK ( 1 ) ) 

DIMENSION  AA(3,4) .Aft(lO) 

M  =  NSTATN  +  1 
DO  100  K=l, NSTATN 
M  =  M  -  1 
ITSK=4 
RDK=1  . 

IF  (NOFSET(K)  ,LT.  2)  GO  TO  21 
NNODES  =  NOFSET(K) 

BLOCAL  =  BMKvK) 

TLOCAL  =  DK(K) 

ORG  =  TLOCAL  -  VCG 
CAC  =  CAK(K) 

GDB  =  ABS(0RG)/(2. ♦BLOCAL) 

RMIN=1 .E38 
NNM=NNQDES-1 
DO  31  1=2, NNM 

DO  32  1=1.3 

IDX=I+J-2 

AA(J,l)=Y(IDX,K)^*2+Z(inX,K)^*2 
AA(J,2)=Y(1DX,K) 

AA(J.3)=Z(IDX.K) 

AA(J ,4)si .0 
CONTINUE 
A=CMINR(1,AA) 

E=-CMINR(2,AA) 

C=CMIKR(3,AA) 

D=-CMINR(4,AA) 

IF  (A  .EQ.  0)  GO  TO  33 
DY=YCI+1,K)-Y(I-1,K) 

IF  (AES(DY)  .EQ.  0.)  GO  TO  33  _  , 

ZT=Z(1-1 ,K)+(Z(I+1 ,K)-Z(I-1,K))*(Y(I,K)-Y(I-1,K))/DY 

IF(ZT.LE.Z(I,K))  CO  TO  33 

YCs-B/(2.*A) 

ZC=-C/(2.*A)  , 

R=SQRT(ABS(YC*YC+ZC*ZC-D/A)) 

AP.(I)  =  R 

IF  (R  .LT.  RMIN)  RHIN=R 
33  CONTINUE 
31  CONTINUE 
IIDK=RM1N 

SERE  not  us«d  (triangula.T  sections) 

IF  (BDG.GT.0.8  .AND.  BDG.LE.2.26)  ITSK  =  3 

IF  (CAC  .GT.  0.66)  ITSK  =  4 
IF  (CAC  .GE.  0.06)  ITSK  =  2 
IF  (GDB  .GE.  1.2)  ITSK  =  1 

no  •ddym&king  (TANAKA)  lor  stations  with  hilgekeols 

IF  (HBKSET  .Eg.  0)  GO  TO  40 
DO  30  I=1,KBKSET 
KBKS  =  NBKSTN(I) 

DO  20  J=1 ,NBKS 

IF  (.NOT.(STATN(M).EQ.BKSTN(J,I)))  GO  TO  20 
YBK  =  BKHBO.I) 

ZBK  BKWLU.I)  -  DBLWL 


32 


1000 


WRITE  (IPRIN.IOOO)  BKSTH(J,I) .YBK.ZBK 
FORMAT  (/ 3810.2) 
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11 

12 


Ml  =  2 
M2=NNM 

DO  11  NN=2,NNM 

IF  (Z(NK,K) .LT.ZBK)  GO  TO  11 

M2=NN 

M1=NN-1 

IF  (Z(NN,K) .EQ.ZBK)  M2=NN+1 

GO  TO  12 

CONTINUE 

CONTINUE 


L  =  NNQDES 
DO  13  NN=2,NNM 
L  =  L  -  1 
R  =  AR(L) 

WRITE  (IPRIN.lOlO)  Y(L,K),Z(L.K).AR(L) 

1010  FORMAT  (2F10.2,1PE12.2) 

13  CONTINUE 

WRITE(IPRIN.lOll)  M1,H2 

1011  FORMAT  (■  Ml,  M2  =  ’,216) 

*  search  lor  minimum  radius  ol  the  bilge  starting  Irom  the  waterline 

RMIN  =  AR(M2) 

L  =  M2+1 
DO  15  NN=M1,M2 
L  =  L  -  1 
R  =  AR(L) 

IF  (R  .GT.  RMIN)  GO  TO  17 
RMIN  =  R 
15  CONTINUE 
17  RDK  =  RMIN 

WRITE  (IPRIN,1020)  RMIN 
1020  FORMAT  (8H  RMIN  =,1PE12.2) 

ITSK  =  4 
GO  TO  21 

20  CONTINUE 
30  CONTINUE 
40  CONTINUE 

SERE  used  lor  sections  with  skegs 

IF  (NSKSET  .Eq.  0)  GO  TO  60 
DO  50  1=1, NSKSET 

IF  (STATN(H)  .LE.  SKAUS(I)  .AND.  STATN(M)  .GE.  SKFLS(I))  ITSK  =  3 
SO  CONTINUE 
60  CONTINUE 

21  CONTINUE 
RD(K)=RDK 
ITS(K)=ITSK 

100  CONTINUE 

RETURN 

END 

C  DECK  SERAB 

SUBROUTINE  SERAB  (K,ROLANG ,BLOCAL,TLOCAL,ORG ,RD , EDDY , RGB) 
EXTERNAL  EXP 


*  calculates  eddy~meJting  roll  damping  data  lor  TANAKA  series  A  and  B 

*  REF-  TANAKA.  J.  ZQSEN  KIOKAI,  VOL.  109,  1961 

RGB  =  SqRTCORG*ORG  +  BLOCAL*BLOCAL)  -  RD*(sqRT(2. )-l . ) 

BDG  =  2.*BL0CAL/ABS(0RG) 

C  =  FIG66(R0LANG,BDG)*EXP(-FIG7(R0LANG)*RD/ABSCTL0CAL)) 

C  =  C*FTWO(K,TLOCAL,RD) 
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RETURN 

END 


C  DECK  SERD 

SUBROUTINE  SERD  (K,ROLANG,BLOCAL,TLOCAL,ORG, EDDY, RGB) 
EXTERNAL  EXP 

*  calculates  eddy-maJting  roll  damping  data  for  TANAKA  series  D 

*  REF-  TANAKA,  J.  20SEN  KIQKAI .  VOL.  109,  1961 

RGB  =  ABS(ORG) 

IF  (BLOCAL  .LE.  0.)  C  =  0.63 
IF  (BLOCAL  .LE.  0.)  GO  TO  10 
GDB  =  RGB/(2.*BL0CAL) 

REQ  =  FIG10(GDB)*BL0CAL 
BDG  =  l./GDB 

C  r  FIG56(R0LANQ,BDG)+EXP(-FIG7(RQLANG)*REq/AES(TLQCAL)) 
10  CONTINUE 

C  =  C*FTWO(K,TLQCAL,REQ) 

EDDY  =  C 


RETURN 

END 

C  DECK  SERE 

SUBROUTINE  SERE  (BLOCAL, DRG, EDDY, RGB) 

*  calculates  eddy-making  roll  damping  data  for  TANAKA  series  E 

•  REF-  TANAKA,  J.  ZOSEN  KIOKAI,  VOL.  109,  1961 

RGB  =  ABS(QRG) 

BDG  =  2.*BL0CAL/ABS(0RG) 

C  ^  FIGll(BDG) 

EDDY  =  C 


RETURN 

END 


C  DECK  SETSEV 

SUBROUTINF';  SETSEV  (NSVRSP  .LSVRSP) 

COMMON  /RESPN/  NRESP,IP0INT(182) ,IM0TN(182) ,ITYPE(182) , 
2  ILIN(182),ISYK(182) 

LOGICAL  ILIH.ISYM 

DIMENSION  LSVRSP(NSVRSP) 


10 

20 

4 

30 

>« 


DO  160  LR=1, NSVRSP 
DO  140  IR=1,KRESP 
IP  =  IPOINT(IR) 

IM  =  IMOTN(IR) 

XT  ==  ITYPE(IR) 

GO  TO  (10, 20, 30, 40, 60, 60, 70, 80, 90, 100, 110, 120, 130), LR 

IF  (.NOT.  (IP.EQ.O  .AND.  IM.Eq.3  .AND.  IT.Eq.l))  GO  TO  140 

heave 

GO  TO  IBO 

IF  (.NOT.  (IP.Eq.O  .AND.  IM.Eq.6  .AND.  IT.EQ.l))  GO  TO  140 


pitch 

GO  TO  160 

IF  (.HOT.  (IP.EQ.O  .AND.  IM.Eq.2  .AND.  IT.EQ.l))  GO  TO  140 
sway 

GO  TO  160 

IF  (.HOT.  (IP.EQ.O  .AND.  IH.EQ.4  .AND.  IT.EQ.l))  GO  TO  140 


1()1 


*  roll 

GO  TO  IBO 

BO  IF  (.HOT.  (IP.EQ.O  .AHD.  IH.EQ.6  .AND.  IT.EQ.l))  GO  TO  140 


*  yaw 

GO  TO  160 

60  IF  (.HOT.  (IP.EQ.l  .AND.  IM.EQ.3  .AND.  IT.EQ.3))  GO  TO  140 

*  vertical  acceleration  at  point  1  (pi) 

GO  TO  150 

70  IF  (.NOT.  (IP.EQ.l  .AND.  IM.Eq.2  .AND.  IT.EQ.3))  GO  TO  140 

><■  lateral  acceleration  at  point  1  (pi) 

GO  TO  160 

80  IF  (.NOT.  (IP.EQ.2  .AND.  IM.EQ.3  .AND.  IT.EQ.3))  GO  TO  140 

*  vertical  acceleration  at  point  2  (p2) 

GO  TO  150 

90  IF  (.NOT.  (IP.Eq.2  .AND.  IM.EQ.2  .AND.  IT.EQ.3))  GO  TO  140 

+  lateral  acceleration  at  point  2  (p2) 

GO  TO  160 

100  IF  (.NOT.  (IP.EQ.3  .AND.  IM.EQ.3  .AND.  IT.EQ.3))  GO  TO  140 

vertical  acceleration  at  point  3  (p3) 

GO  TO  160 

110  IF  (.NOT.  (IP.EQ.3  .AND.  IM.EQ.2  .AND.  IT.EQ.3))  GO  TO  140 

*  lateral  acceleration  at  point  3  (p3) 

GO  TO  ISO 

120  IF  (.NOT.  (IP.EQ.4  .AND.  IM.EQ.S  .AND.  IT.EQ.3))  GO  TO  140 


*  vertical  acceleration  at  point  4  (p4) 

GO  TO  150 

130  IF  (.NOT.  (IP.Eq.4  .AND.  IM.Eq.2  .AND.  IT.EQ.S))  GO  TO  140 

*  lateral  acceleration  at  point  4  (p4) 

GO  TO  160 

140  CONTINUE 

160  LSVRSP(LR)  =  IR 

160  CONTINUE 

RETURN 

END 


C  DECK  SEVMOT 

SUBROUTINE  SEVMOT 


(NSVRSP .RSPNME ,HDNG .IMODL) 


COMMON  /DATINP/  OPTN.HOTN ,BSCF1L,VLACPR,RA0PR,RLDMPR,DISPLMT, 
2  LRAOPR , ADRPR , ORGOPTN , GMNOM . KG . STATN (26 ), »SOFST ( 25 ) , 

2  NLEWF ( 25 ) , HLFBTH (10,25), WTRLNE( 10,26), BLEWF ( 25 ) , TLEWF ( 25 ) , 

2  AREALF (265  , NPTLOC , PTNUMB ( 1 0 ) , PTN AME , XPTLOC ( 1 0 > . ( 1 0 ) , 

2  ZPTL0C(10),NaB,FBNUHB(lO),FBNAME,pTFBp(10),YPTF|D(10), 

2  ZPTFBD  a  0 ) , FBCODE ( 10 ) , FBTYPE , RDOT ( 10 ) , VKDES , FNDES , 

9  ^TATNM  ^TATIS 

CHARACTER*4  PTNAME(8,10).FBNAME(8  ip).STATHM(6)  FBTYPE(3  10) 
INTEGER  OPTH ,MOTN ,BSCFIL,VLACPR,RAOPR, ADRPR, RLDMPR, FBCODE, 

2  FBNUMB, PTNUMB, ORGOPTN 
REAL  KG 


COMMON  /EKVIOR/  VK , HVK , MU , «MU,OHEGA,KOHEGA, SIGMA ,NSIGMA , SI 

1  NSlGHH,TMuDAL,Klriuu,KRAnG,RAnvj,ni,Ai«\j,  ..  3 


GWH, 
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INTEGER  NVK , NMU , NOMEGA . NSIGMA . HSIGWH , NTMOD , NRANG , NNHU (8 ) 

REAL  VK(8),MUf37,8) .OMEGAOO) ,SIGMA( 10 ) ,S1GWH(4) ,TH0DAL(8) , 

2  RANG(8) ,RLANG(8) ,3(30,8) .FRHUM(8) ,VFS(8) 

COMMON  /GEOM/  X.NSTATN.Y, 2, NQFSET.LPP, BEAM. DRAFT. LCF, 

VCG , GM .DELGM , NEBLA .KPITCH .KROLL .KYAW .KYAWRL , AWP , VCB , FBDX , FBDY , 
FBDZ , NFREBD , XPT , YPT , ZPT , KPTS ,LCB , GML , ASTAT , BSTAT . TITLE . M ASS , 
DISPLM , IPITCH , IROLL . lYAW , lY AWRL .CHEAVE .CPITCH . CHEAPI , CROLL . 
AREAMX.WSURF, GIRTH, FBDZV.DBLWL.TLCB 
INTEGER  NSTATN ,N0FSET(25) , NFREBD, NPTS 
CHARACTER*4  TITLE(20) 

REAL  X(25) ,Y(10.25) ,Z(iO,25) ,FBDZV(8 . 10) ,LPP ,BEAM,DBLWL ,TLCB , 

2  DRAFT ,LCF , VCG . GM, DELGM .NEBLA .KPITCH . KROLL, KYAW .KYAWRL , AWP , VCB , 

2  FBDX(10),FBDY(10) ,FBDZ(10) ,XPT(10) .YPT(IO) ,ZPT(10) .LCB.GML, 

4  ASTAT(25) ,BSTAT(25) .MASS , DISPLM , IPITCH .IROLL . lYAW , 

6  I YAWRL , CHEAVE . CPITCH , CHEAPI , CROLL . AREAMX , WSURF . GIRTH ( 25 ) 

COMMON  /INDEX/  PFIDX .LPFIDX .RMIDX.LRMIDX.SVIDX, LSVIDX 

INTEGER  LPFIDX, LRMIDX, LSVIDX 

REAL  PFIDX(236) ,RMIDX(183) ,SVIDX(3) 

COMMON  /lO/  SYSFIL.POTFIL.CQFFIL.LCOFIL.ICARD.TEXFIL.IPRIN, 

2  SCRFIL , HPLFIL . LRAFIL . ORGFIL . RAQFIL . RMSFIL . SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL , POTFIL , COFFIL .LCOFIL . ICARD . TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL . RAOFIL . RMSFIL . SEVFIL . SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /PHYSCO/  II . TPI , PI , PIOT .DEGRAD . RADDEG . VKMETR , METRVK , GRAV , 
2  RHQ . GNU . RHOS . RHQF . GNUS . GNUF . FTMETR . PUN ITS . RE YSCL 
COMPLEX  II 

CHARACTER*4  PUNITS(2) 

REAL  TPI , PI . PIOT , DEGRAD . RADDEG . VKMETR . METRVK , GRAV ,RHO . GNU . RHOS . 

1  RHOF, GNUS. GNUF, FTMETR 

COMMON  /SEVERE/  NRSIND,RSINDX,NSWIND,SWINDX,RSVTOE,RV,RH 
REAL  RSINDX(14) .SWINDXCS) .RSVT0EC402) 

INTEGER  RV(13) ,RH(13) 

COMMON  /SMPSYS/  FIS .AS . SIS .SOS, SDS .HALOS, DEV ,PRN .SKPPS . SMPIS . 

2  SMPOS . SMPDS . SHPTYPS . SHIPS . VARS . CYCLS . TITLES . OPTION , LSIS , LSOS . 

2  LSDS . LH ALOS , LDEV . LPRN . LSMPPS , LSMPIS , LSMPOS , LSMPDS , LSHPTYPS . 

2  LSHIPS.LTITLES 
CHARACTERvieO  AS 

CHARACTER*80  FIS . SIS . SOS .SDS .TITLES 

CHARACTER+20  HALOS ,DEV . PRN . SMPPS, SMPIS .SMPOS .SMPDS .SHPTYPS 
CHARACTER  SHIPS*6 . VARS*2 ,CYCLS*2 
IBTEGER*2  OPTION 

DIMENSION  RSV(13, 13) ,T0E(13,13) .TEHV(13) ,TEMH(13) ,TEMR(13) , 

2  TEMT{13) ,L3VR3P(13) ,HDNG(24) ,IMQDL(4) 

CHARACTER*4  RSPNME(2,13) 

INTEGER  TEMT 
CHARACTER*4  METER 

DATA  METER  /’METE’/ 

DATA  LSVRSP  /2. 4, 1 ,3,6  ,7 .6 ,9 ,8, 11 , 10, 13, 12/ 

FIS  =  SDS(1;LSDS)//’ .SEV’ 

OPEN  {UNIT=SEVFIL,FILE=FIS,STATUS= ’UNKNOWN’ , 

2  ACCESS=’DIRECT’ ,RECL=1620) 

NHEAD  =  24 
HI  =  NHEAD  +  1 
KDATA  =  2  +  N1*NVK*2 
DO  600  IC=1,2 
DO  400  1S=1,NSIGWH 
LT  =  IMODL(IS) 

DO  300  IR=1.NSVRSP 
DO  200  JR=1,HSVRSP 
LR  =  LSVRSP (JR) 

INDEX  =  NSIGWH  *  NSVRSP  *  (IC  -  1)  +  NSIGWH  ♦  (LR  -  1)  +  IS 
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READ  (SEVFJ.L,REC=INDEX)  RSVTQE 


*  CDC  CALL  FETCH  (IC ,LR , IS, RSVTQE, SVIDX.RSINDX .SWINDX .KDATA .LSVIDX , 
t-  CDC  2  NSVRSP.NSIGWH.SEVFIL) 


IF  (IR  ,GT.  1)  GO  TO  10 
RV(JR)  =  RSVTOE(l)  +  .001 
RH(JB)  =  RSVT0E(2)+  .001 
D  IF  (JR  .GT.  1)  GO  TO  20 
IV  =  RV(IR) 

IH  =  RH(IR) 

3  IE  =  3  +  (IH-1)*2  +  (IV-1)»NHEAD*2 
RSVCJR.IR)  =  RSVTOECIE) 

TOE(JR.IR)  =  RSVT0E(IE+1) 

D  CONTINUE 
3  CONTINUE 

WRITE  (IPRIN.IOOO)  TITLE 
3  FORMAT  (1H1,/,28X,20A4,///,48X,28HS  E  V  E  R  E 
2  9HT  A  B  L  E) 


IF 

(IC 

•  EQ.  1 

WRITE 

(IPRIN.IOIO) 

IF 

dc 

■EO.  2) 

WRITE 

(IPRIN.1020) 

1010  FORMAT 

(//,60X 

.IIHLONGCRESTED) 

MOTION 


3  FORMAT  (//,60X,12HSH0RTCRESTED) 

IF  (PUNITS(l)  .KE.  METER)  WRITE  (IPRIN,1030)  SIGWH(IS) 

IF  (PUNITS(l)  .EQ.  METER)  WRITE  (IPRIN,1040)  SIGWH(IS) 

3  FORMAT  (/.42X.37HSEA  STATE:  SIGNIFICANT  WAVE  HEIGHT  = 

2  .F6.2,7H  FEET  ) 

3  FORMAT  C/,42X,37HSEA  STATE;  SIGNIFICANT  WAVE  HEIGHT  - 
2  ,F6.2,7H  METERS) 

WRITE  (IPRIN.IOSO)  TMQDAL(LT) 

0  FORMAT  (54X,19HM0DAL  WAVE  PERIOD  =,F4.0,8H  SECONDS) 

IF  (NSVRSP  .EQ.  6)  GO  TO  60 
NP  s  NSVRSP  -  5 
NP  =  NP  /  2 
WRITE  (IPRIN,102B) 

5  FORMAT  (//,84X.16HP0INT  LOCATIONS:) 

DO  BO  IP=1,NP 

WRITE  (IPRIN,1026)  IP , (PTNAKECl ,IP) ,1=1 ,8) ,XPTLOC(IP) , 

2  YPTLOC(IP),ZPTLOC(IP) 

5  FORMAT  (22X.1HP, II, 3H-  ,8A4 ,2X,5HXFP  =,F7 .2,2X,SHYCL  = .F7 .2 .2X , 

2  5H2BL  =,F7.2) 

CONTINUE 


60  CONTINUE 

WRITE  (IPRIN.IOBB)  (STATNM(I ) ,1=1 ,3) 

1055  FORMAT  (/,40X,3A4,39H  VALUE  /  ENCOUNTERED  MODAL  PERIOD  (TOE)) 
WRITE  (IPRIN,1060)  ((RSPNME(I ,IR) .1=1 ,2) ,IR=1 , NSVRSP) 

1060  FORMAT  (/,48X,32HMAXIMUM  RESPONSES  AND  CONDITIONS IX, 

2  130(lH-),//,14H  RESPONSE  .13(4X.A4,A1)) 

DO  310  IR=1, NSVRSP 
IV  =  RVCIR) 

IH  =  RH(IR) 

TEMV(IR)  =  VK(IV) 

TEMH(IR)  =  HDNG(IH) 

TEMR(IR)  =  RSVdR.IR) 

IF  (IR  .GT.  6)  TEMR(IR)  =  TEMR(IR)  ♦  100 
TEMT(IR)  =  TOEdR.IR) 

IF  (TEHT(IR)  .GE.  99)  TEMT(IR)  =  99 
310  CONTINUE 

WRITE  (IPRIN,1070)  (TEMR(IR) ,TEMT(IR) ,IR=1 .NSVRSP) 

1070  FORMAT  (/,14H  (MAX.RSV)/T0E,13dX.F5.2.1H/.I2)) 

WRITE  (IPRIN.IOSO)  (TEMV(IR) ,IR=1 .NSVRSP) 
lOBO  FORMAT  (17H  AT  SPEED  (KNOTS) ,F6 . 1 . 12F9 . 1) 

WRITE  (IPRIN,1090)  (TEMH(IR) ,IR=1 .NSVRSP j 
1090  FORMAT  (17H  AT  HEADING  (DEG) ,F6.0,12F9.0) 

WRITE  (IPRIN.llOO)  ((RSPNME(1,JR),I=1.2),JR=1,HSVRSP) 

1100  FORMAT  (//,64X.20HASS0CIATED  RESPONSES ,/, IX , 130(1H-) ,// , 

2  16H  MAX.  SPEED  /,/,15H  RESPN.  HEADING, 3X. A4,A1 , 12 (4X,A4 ,A1) ) 
WRITE  (IPRIN,  111.0) 

1110  FORMAT  (IX) 

Du  330  1R=1, NSVRSP 
IV  =  RV(IR) 

IH  =  RH(IR) 
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MV  =  VK(IV)  +  .001 
MH  =  HDNG(IH)  +  .001 

IF  (IR.EQ.6  .OR.  IR.EQ.8  .OR.  IR.EQ.IO  .OR.  1R.EQ.12) 

2  WRITE  (IPRIN.lllO) 

DO  320  JR=1.KSVRSP 
TEMR(JR)  =  RSV(JR,IR) 

IF  (JR  .GT.  S)  TEMR(JR)  =  TEHR(JR)  •  100 
TEMT(JR)  =  TQE(JR.IR) 

IF  (TEMT(JR)  .GE.  99)  TEMT(JR)  =  99 
320  CONTINUE 

WRITE  (IPRIN,1120)  (RSPNME(I . IR) ,1=1,2) ,MV.MH,(TEMR(JR) ,TEMT(JR) , 
2  JR=1,NSVRSP) 

1120  FORMAT  ( IX , A4, A1 ,2X, 12, IH/, 13 , 13(F6.2 , 1H/,I2) ) 

330  CONTINUE 

WRITE  (IPRIN,1130) 

1130  FORMAT  (// ,2X .42HN0TES :  1)  RESPONSES  ARE  IK  PHYSICAL  UNITS;,/, 

2  22X,50HHEAVE  AND  SWAY  ARE  IN  WAVE  HEIGHT  UNITS;  PITCH,  , 

2  29HR0LL,  AND  YAW  ARE  IN  DEGREES :,/ .22X , 23HAND  THE  POINT  VERTICAL, 
2  S3HAND  LATERAL  ACCELERATIONS  ARE  IN  UNITS  OF  G-S  *  100.) 

WRITE  (IPRIN,1140) 

1140  FORMAT  (9X,51H2)  POINT  LOCATIONS;  XFP  IS  IN  STATION  NUMBERS; 

2  ,37HYCL  AND  2BL  ARE  IN  WAVE  HEIGHT  UNITS.) 

WRITE  CIPRIN,1150) 

1150  FDRMAT(9X,52H3)  HEADING  CONVENTION:  0  DEG=HEAD,  90  DEG=STBD  BEAM, 
2  ,24H  180  DEG=FQLLOWING  SEAS.) 

400  CONTINUE 
600  CONTINUE 

CLOSE  (UNIT=SEVFIL) 

RETURN 

END 

C  DECK  SKFRSP 

FUNCTION  SKFRSP  (WE ,LPP , V ,SFD) 

REAL  LPP 

SKFRSP  =  SFD*(1.  +  4.1*V/(WE*LPP)) 

RETURN 

END 

C  DECK  SKLIFT 

SUBROUTINE  SKLIFT 

COMMON  /APPEND/  NBKSET,NBKSTN(2)  ,BKIMAG(2) ,BKFS(2) ,BKAS(2) , 

2  BKWD(2),BKSTN(10,2)  ,BKHB(10.2),BKLNTH,BKWDTH, 

2  BKWL(10,2) ,BKAN(1C,2) ,NSKSET,SKIMAG(2) ,SKFLS(2) ,SKALS(2) , 

2  SKAUS(2) ,SKHB(2),SKFLWL(2).SKALWL(2j,SKAUWL(2),HRDSET,RDIMAG(2), 

2  RDRFS(2) ,RDRAS(2),RDRHB(2) ,RDRFWL(2) ,RDRAWL(2) ,RDTFS(2) ,RDTASC2) , 
2  RDTHB(2),RDTFWL(2) ,RDTAWL(2) ,NSBSET,SBIHAG(2) ,SGBRFS(2) ,S0SRA3(2) 
2,S0BRHB(2) ,S0BRFW(2) ,S0BRAW(2) ,SIBRFS(2) ,SIBRAS(2) ,SIBRHB(2) , 

2  SIBRFW(2) ,SIBRAW(2) ,SBTFS(2) ,SBTAS(2) ,SBTHB(2) ,SBTFWL(2) , 

2  SBTAWL(2) ,NFNSET,FNIMAG(2) ,FNRFS(2) ,FNRAS(2) , 

2  FNRHB(2),FNRFWL(2),FNRAWL(2) ,FNTFS(2) ,FHTAS(2) ,FNTHB(2) , 

2  FNTFWL(2) ,FNTAWL(2) .HEXPRD ,ENRD0(8) ,EHRDS(8) 

COMMON  /ENVIOR/  VK.NVK, MU, NMU,QMEGA,NOMEGA, SIGMA, NSIGMA.SIGWH, 

1  NSIGWH ,TMODAL , NTMOD , NRANG , RANG , RLANG ,S , NNMU . FRNUM , VFS 
INTEGER  N VK , NMU , NOMEGA , NSIGMA , NSIGWH , NTMOD ,NRANG . NNMU(8 ) 

REAL  VK(8) ,HU(37,8) ,0MEGA(30) ,SIGMA(lO) ,SIGWH(4) ,TM0DAL(8) , 

2  RANG(8) ,RLANG(8) ,S(30,8) ,FRNUM(8) ,VFS(8) 

COMMON  /GEOM/  X.HSTATH ,Y,Z,NOFSET, LPP, BEAM, DRAFT, LCF, 

1  VCG , GM , DELGM , NEBLA , KPITCH , KROLL , KYAW . KY AWRL , AWP , VCB , r BDX . FBDY , 

2  FBDZ , NFREBD , XPT , YPT , ZPT , NPTS , LCB , GML , ASTAT , BST AT , TITLE .MASS, 

2  DISPLM , IPITCH , IROLL , lYAW . lYAWRL , CHEAVE, CPITCH , CHEAPI , CROLL , 

2  AREAMX , WSURF .GIRTH , FBDZV .DBLWL .TLCB 

IHTEGEP.  NST.ATN  ,NnFSF.T(26)  .NFREBD, NPTS 
CHARACTER*4  TITLE (20) 

REAL  X(2B),Y(10,26),Z(10,26),FBDZV(8,10),LPP.BEAM,DBlWL,TLCB. 
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Cn  fO 


DRAFT, LCF.VCG.GH.DELGM.NEBLA.KPITCH.KROLL.KY AW, KYAWRL,AWP,VCa, 
FBDX(10),FBDY(10) ,FBDZ(10) ,XPT(10) .YPT(IO) ,ZPT(10) .LCB.GML, 
ASTAT(2B) ,BSTAT(25) .MASS .DISPLM , IPITCH , IROLL . lYAW , 
lYAWRL, CHEAVE,CPITCH,CHEAPI,CROLL.AREAMX, USURP, GIRTH t25) 

COMMON  /PHYSCO/  II , TPI , PI , PIQT , DEGRAD , R ADDEG , VKMETR , METRVK , GRAY , 

2  RHO , GNU . RHOS , RHQF , GNUS , GNUF , FTMETR , PUN ITS , REYSCL 
COMPLEX  II 

CHARACTER*4  PUNITS(2) 

REAL  TPI, PI. PIOT, DEGRAD. RADDEG, VKMETR, METRVK, GRAY, RHO, GNU, RHOS, 

1  RHOF, GNUS, GNUF, FTMETR 

COMMON  /RLDBK/  PSUR(25) .BMK(2B) .DK(2B) ,CAK(2B) ,HQ .HSPAN .HMNCHD , 

2  HAREA.HXCP,HYCP,HZCP,HGAMMA,HYHAT,HEAR,HLCS,RQ(2) ,RSPAN(2) , 

2  RMNCIID(2) ,RAREA(2) ,RXCP(2) ,RYCP(2) .RZCP(2) ,RGAMMA(2) .RYHAT(2) , 

2  REAR(2) ,RLCS(2) ,SQ(2) ,SSPAN(2) ,SMNCHD(2) ,SAREA(2) ,SXCP(2) , 

2  SYCP(2),SZCP(2) ,SGAMMA(2),SYHAT(2),SEAR(2) , SLCS(2) , BQ (2 ) , 

2  BSPAN(2) ,BMNCHD(2) ,BAREA(2) .BXCP(2) ,BYCP(2) , BZCP (2) , BGAMMA (2) , 

2  BYHAT(2) ,BEAR(2) ,BLCS(2) .FQ(2) ,FSPAN(2) ,FMNCHD(2) ,FAREA(2) , 

2  FXCP(2) .FYCP(2) .FZCP(2) ,FGAMMA(2) ,FYHAT(2) .FEAR(2) ,FLCS(2) , 

2  PQ(2,2) ,PSPAN(2,2)  .PMNCHD(2 ,2) ,PAREA(2 , 2) , PXCP (2 , 2; , PYCP (2 , 2) , 

2  PZCP(2.2) ,PGAMMA(2.2),PYHAT(2,2) ,PEAR(2.2) ,PLCS(2,2) , 

2  STADMP(IO)  .SHPDMPdO.B)  .ENCON  , WPHI  .TPHI . WHELM(4 , 9 ) , SFELH (4 , 9 , 8 ) , 

2  REELM(4,9,8)  ,  PEELM(4  .9 . 8 )  .  FEELM(4 ,9 . 8)  ,  HF.ELM(4 ,9 . 8 ) .  BEELM(4 ,9 , 8 )  , 
2  ENWM,ENSF(8,8) ,ENRE(8) .ENPE(8) .ENFE(8) ,ENHE(8) ,ENBE(8) , 

2  ENEMV(;8.8) ,ENRL(8) ,ENPL(S) , ENFL{8) ,ENHL(8) , ENSL(8 ) , ENBL(8) , 

2  ENSHP(8,8) ,RELM(4,9) , ITS(26) ,RD(25) ,EDDY(8 , 25) ,RGB(25) 

REAL  RDBLK(2692) 

EQUIVALENCE  (PSUR( 1 ) . RDBLK( 1) ) 

REAL  LCS.MCHORD 

IF  (NSKSET  .EQ.  0)  GO  TO  20 
EN  a  0 

STASPC  =  LPP/20 

DO  10  K^^i, NSKSET 

XSKF  =  LCB  -  SKFLS(K) ♦STASPC 

XSKAU  a  LCB  -  SKAUS(K)^STASPC 

XSKAL  a  LCB  -  SKALS(K)^STASPC 

YSKG  =  SKHB(K) 

ZSKF  =  SKFLWL(K)  -  (DBLWL+VCG) 

ZSKAU  a  SKAUUL(K)  -  (DBLWL+VCG) 

ZSKAL  a  SKALWL(K)  -  (DBLWL+VCG) 

Q  a  SKIMAG(K) 

GAMMA  a  -  90 

SPAN  =  ZSKAU  -  ZSKAL 

MCHORD  =  (XSKF  -  XSKAL)/2 

♦  area 

AREA  =  SPAN+MCHORD 

♦  center  ol  pressure 

XCP  a  XSKAL  +  (XSKF  -  XSKAL)/3 
YCP  =  YSKG 

ZCP  a  ZSKF  +  (ZSKAU  -  ZSKF)/6 

♦  moment  arm 

GAM  =  GAMMA+DEGRAD 

YHAT  a  YCPaCOS(GAM)  +  ZCP+SIN(GAM) 


♦  elfective  aspect  ratio 

EAR  =  2+SPAN/MCHORD 

♦  lilt  curve  slope 

LCS  =  (PI/2) ♦EAR 
SQ(K)  a  Q 
SSPAN(K)  a  SPAN 
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SMNCHD(K)  =  MCHORD 
SAREA(K)  =  AREA 
SXCP(K)  =  XCP 
SYCP(K)  =  YCP 
SZCP(K)  =  ZCP 
SGAMMA(K)  =  GAMMA 
SYHAT(K)  =  YHAT 
SEAR(K)  =  EAR 
SLCS(K)  “  LCS 

EH  =  EN  +  q*(RH0/2)fAREA*LCS*YHAT*YHAT*WPHI*ENCQN 
10  CONTINUE 
20  CONTINUE 

DO  30  IV=1,NVK 
ENSL(IV)  =  0 

IF  (NSKSET  .GT.  0)  ENSL(IV)  =  EN*VFS(IV) 

30  CONTINUE 

RETURN 

END 

C  DECK  SKHFRC 

SUBROUTINE  SKNFRC 

COMMON  /CH3D/  ISIGMA.SIGHIN.SIGMAX.V.SINMU.CDSHU.WTSI, 

2  IMHIN.IMHAX.IMDEL.LMIN.LMAX 

REAL  SIGMIN,SIGMAX.V.SINMU,C0SMU.WTSI(4) 

INTEGER  ISIGMA , IMMIN , IMMAX , IHDEL ,LMIN ,LMAX 

COMMON  /ENVIOR/  VK .NVK , MU .NMU .OMEGA .NOMEGA .SIGMA .NSIGMA . SIGWH , 

1  NSIGWH .TMODAL . NTMGD  . NRANG . RANG . RLANG . S . NNMU . FRNUM . VFS 
INTEGER  NVK . NMU . NOMEGA . NSIGMA .NSIGWH , NTMOD .NRANG ,NNHU(8 ) 

REAL  VK(8) .MU(37.6) ,0MEGA(30) .SIGMA( 10) ,SIGWH(4) ,TMDDAL(8) , 

2  RANG(8) .RLANG(8) .3(30,8) ,FRNUM(8) ,VFS(8) 

COMMON  /GEOM/  X.NSTATN.Y.Z.NQFSET.LPP, BEAM, DRAFT, LCF, 

1  VCG , GM , DELGM . HEELA , KPITCH . KROrj. . KYAW .KYAWRL . AWP . VCB . FBDX . FBDY , 

2  FBD2 . NFREBD . XPT . YPT , ZPT , NPTS , LCB . GML . ASTAT . BSTAT , TITLE , M ASS , 

2  DISPLM , IP ITCH , IRQLL , lYAW . I YAWRL . CHEAVE , CPITCH , CHEAPI , CROLL , 

2  AREAMX , WSURF .GIRTH , FBDZV.DBLWL .TLCB 

INTEGER  NSTATN ,N0FSET(26) .NFREBD, NPTS 
CHARACTER *4  TITLE (20) 

REAL  X(26) ,Y( 10,25) ,2(10 ,26) ,FBDZV(8 , 10) ,LPP, BEAM, DBLWL, TLCB . 

2  DRAFT , LCF , VCG . GM. DELGM , NEBLA , KPITCH ,KROLL, KYAH , KYAWRL , AWP , VCB , 

2  FBDX (10), FBDY (10) ,FBDZ(10) ,XPT(10) ,YPT(10) .ZPT(IO) ,LCB,GML, 

4  ASTAT(25) .BSTAT(26) .MASS, DISPLM, IPITCH.IROLL.IYAW, 

6  I YAWRL , CHEAVE , CPITCH . CHEAP I . CROLL , AREAMX , WSURF , G IRTH ( 25 ) 

COMMON  /PHYSCO/  II, TPI, PI, PIOT, DEGRAD, RADDEG.VKMETR.HETRVK.GRAV, 

2  RHO , GNU , RHOS , RHOF , GNUS , GNUF .FTMETR , PUNITS . REYSCL 
COMPLEX  II 

CHARACTER+4  PUNITS (2) 

REAL  TPI, PI, PIOT, DEGRAD, RADDEG.VKMETR.HETRVK.GRAV, RHO, GNU. RHOS. 

1  RHOF, GNUS, GNUF, FTMETR 

COMMON  /RLDBK/  PSUR(25) .BMK(2S) ,DK(25) ,CAK(25) .HQ .HSPAN .HMNCHD , 

2  HAREA.HXCP.HYCP.HZCP.HGAMMA.HYHAT.HEAR.HLCS.RQU) ,RSPAN(2), 

2  RMNCHD(2) ,RAREA(2) ,RXCP(2) .RYCP(2) ,RZCP(2) .RGAMMA(2) ,RyEAT(2) , 

2  REAR(2) ,RLCS(2) ,sq(2) ,SSPAN(2) ,SMNCHD(2) .SAREA(2) ,SXCP(2) , 

2  SYCP(2) ,SZCP(2) ,SGAMKA(2) ,SYHAT(2) ,SEAR(2) ,SLCS(2) ,BQ(2) , 

2  BSPAN(2) ,BMNCHD(2) ,BAREA(2) ,BXCP(2) ,BYCP(2) ,BZCP(2KBGAMMA(2) , 

2  BYHAT(2) ,BEAR(2) ,BLCS(2) ,Fq{2) ,FSPAN(2) .FMNCHD(2) ,FAREA(2) , 

2  FXCP(2) ,FYCP(2) ,FZCP(2) ,FGAMMA(2) .FYHAT(2) ,FEAR(2) ,FLCS(2) , 

2  PQ(2,2) ,PSPAN(2.2) ,PMNCHD(2 ,2) ,PAREA(2 ,2) ,PXCP(2 ,2) ,PYCP(2 ,2) , 

2  PZCP(2,2),PGAMMA(2,2) ,PYHAT(2,2) ,PEAR(2,2) ,PLCS(2,2) , 

2  STADMP(10).SHPDMP(10,8).ENC0N,WPHI,TPHI,WMELM(4,9),SFELM(4,9,8) , 

2  REELM(4,e.8) ,PEELM(4,©,8) ,FEELM(4.9,8) .HEELM(4,9,8) ,BEELM(4,9,8) , 
2  ENWM,ENSF(8,8) ,ENRE(8) ,ENPE(8) ,ENFE{8) ,EHHE(8) ,ENBE(8) , 

2  EHEMV(8,8) ,ENRL(8) ,ENPL(8) ,ENFL(8) ,ENHL(8) ,ENSL(8) ,ENBL(8) . 

2  EHSHP(8,8),RELM(4,9),ITS(2B) ,RD(26) ,EDDY(8.25) ,RGB(2B) 

REAL  RDBLK(2692) 

E.qUi.  viiLc.No£i  (r2UR(  1 )  f  RDBLK ( 1 1  / 
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DATA  RNT/3.E6/ 

DO  10  IA=1,NRANG 
DO  10  IS=1,NSIGMA 
SHPDMPdS.IA)  =  0 
10  CONTINUE 

DO  40  K=1,NSTATN 

IF  145*CAK(K))*(1.7*ABS(DK(K))+CAK(K)’»2*BMKCK)) 

2  +  2.fVCG) 

CON  -  4,/(3.*PI)fRHQ»PSUR(K)*R£**3 
DO  30  IA=1,NRANG 
DO  20  1S=1,NSIGMA 
PERE  =  TPI/SIGMA(IS) 

RN  =  (3.22*(RS»RANG(IA))**2  /  (PERE*GNU))  ♦  REYSCL 
laminar  flow 

CF  =  1.328/SQRT(RN) 


*  turbulent  flow 


20 

30 

40 


45 

SO 


IF  (RH  .GE.  RNT)  CF  =  CF  +  0 . 014+RN** (-0 . 1 14) 
STADMP(IS)  =  CON*SIGMA(IS)*RANG(IA)*CF 
STADMP(IS)  =  SIGMA(IS)*STADMP(IS) 

SHPDMP(IS.IA)  =  SHPDMP(IS.IA)  +  STADMP(1£) 

CONTINUE 
CONTINUE 
CONTINUE 
DO  50  IA=1  .NRANG 

CALL  SPFIT  (SIGMA, SHPDHP(1,IA),SFELM(11,IA),NSIGMA) 
ENSFO  =  ENCON>>REVAL  (SFELH(1 . ISIGMA . lA)  .WTSI ) 

ENSFCIVdAi^^^'^SKFRSP  (WPHI  ,LPP  ,VFS(IV)  ,  ENSFO) 


CONTINUE 

CONTINUE 


RETURN 

END 


C  DECK  SLENTH 

SUBROUTINE  SLENTH  (AS.K) 


CHARACTER* (♦)  AS 
L=LEN(AS) 

K=L*1 

DO  10  M=1,L 
K"K”1 

IF  (AS(K;K) .NE.CHAR(32))  GO  TO  20  !  Test  for  trailing  blanks 

10  CONTINUE 
20  CONTINUE 


RETURN 

END 

C  DECK  SHP93  -  Standard  Ship  Motion  Program  (SMP93) 
PROGRAM  SMP93 


Standard  Ship  Motion  Program  (SHP93) 
for  Personal  Computers 


Operating  system  MS-DOS  Version  4.01 
FORTRAN  77  using  Labey  Fortran 
Overlay  linking  using  PL1NK86 


Hull  plot  and  Speed  Polar/Density  plots 
done  in  separate  programs 
using  HALO  graphics  language 
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to  K>  f  J  »0  i:>  KJ  K)  fO 


COMMON  /APPEND/  NBKSET , NBKSTN (2) , BKIMAG(2) . BKFS(2 ) , BKA3 (2) , 
BKWD(2) ,BKSTN(10,2) . BKHB( 10 , 2 ) , BKLNTH , BKWDTH , 

BKWL(10,2) ,BKAN(10,2) ,NSKSET,SKIMA0(2) ,SKFLS(2) .SKALSC2) . 

SKAUS<2) .SKHB(2) ,SKFLVL(2) ,SKALWL(2) ,SKAUWL(2) , NRDSET , RDIMAG (2) , 
RDRFS(2) ,RDRAS(2),RDRHB(2) ,RDRFW1A2) .RDRAWL(2) ,RDTFS(2) .RDTASIO) , 
RDTHB(2),RDTFWL(2),RDTAWL(2),NSESET.SBIMAG(2) .SOBRFS(2) ,S0BRASC2) 
,S0BRHB(2) ,S0BRFW(2) ,S0BRAW(2) .SIBRFS(2) .SIBRAS{2) ,SlBRHBk2) , 
SIBRFW(2) ,SIBRAW(2) ,SBTFS(2’I  ,SBTAS(2) ,SB1HB(2) ,SBTFWL(2) , 
SBTAWL(2) ,NFNSET.FNIMAG(2) ,FNRFS(2) ,FNRAS(2) , 

FNRHB( 2) ,FNRFWL(2) ,FNRAWL(2) ,FNTFS(2) ,FNTAS(2) ,FNTHB(2) , 

FNTFWLC2) ,FNTAWL(25 .NEXPRD .ENRD0(8) ,EKRDS(8) 

COMMON  /CH3D/  IS1GMA,S1GMIN,SIGMAX,V,SINMU,CQSMU,WTSI. 

2  IMMIN.IHMAX.IMDEL.LMIN.LMAX 

REAL  SIGMIN,SIGMAX,V,SINMU,C0SMU,WTSI(4) 

INTEGER  ISIGMA . IMMIN , IMMAX . IHDEL.LMIN ,LMAX 

COMMON  /DATINP/  QPTN , HQTN . BSCFIL , VLACPR, RAOPR , RLDMPR .DISPLMT , 

2  LRAOPR.ADRPR,ORGOPTN,GMNOH.KG,STATN(25) ,NS0FST(25) , 

2  NLEWF(25),HLFBTH(10,25) ,WTRLNE( 10 ,25 ) .BLEWF(25) ,TLEUF(2S) , 

2  AREALF(2S) .NPTLOC.PTNUMB(IO) , PTNAKE, XPTLOCC 10) .YPTLOCClO) , 

2  ZPTLOCdO) ,NBD,FBNUMB(10) ,FBNAME,XPTFBD(10) .YPTFBDCIO) , 

2  ZPTFBD(IO) ,FBC0DEC10),FBTYPE.RD0T(10) , VKDES ,FNDES , 

2  STATNM.STATIS 

CHARACTER*4  PTNAME(8 . 10) ,FBKAME(8 , 10) ,STATNM(5) ,FBTYPE(3 , 10) 
INTEGER  OPTN . MOTN , BSCFIL , VLACPR, RAOPR . ADRPR , RI.DMPR , FBCODE , 

2  FBNUMB.PTNUMB.ORGOPTN 
REAL  KG 

COMMON  /ENVIOR/  VK  .  NVK , HU . NMU .OMEGA .NOMEGA . SIGMA .NSIGMA , SIGUH , 

1  NSIGWH .ThODAL , NTMOD ,NRANG , RANG . RLANG , S ,NNHU .FRNUM . VFS 
INTEGER  NVK, NMU, NOMEGA, NSIGMA, NSIGUH, NTMOD, NRANG,NNMU(8) 

REAL  VK(8) ,MU(37,8) .QMEGA(30) .SIGMA(IO) ,SIGHH(4) ,TM0DAL(8) . 

2  RANG(6) ,RLAKG(6).S(30,6) ,FRKUK(6) ,VFS(8) 

COMMON  /FTNCON/  lACTFN . IFCLCS .FGAINCS) ,FK(3) .FA( 3) ,FB(3) , 

2  FCLCS(8,2) 

COMMON  /GEOM/  X.NSTATN.Y, 2, NOFSET.LPP, BEAM, DRAFT, LCF, 

1  VCG , GM ,DELGM , NEBLA , KPITCH , KROLL , KY AW , KY AWRL , AWP , VCB , FBDX , FBDY , 

2  FBDZ . NFREBD , XPT . YPT . 2PT , NPTS , LCB , GML . ASTAT , BSTAT . TITLE . MASS , 

2  DISPLM , IPITCH , IROLL , lYAW . I YAWRL , CHEAVE . CPITCH , CHEAPI , CROLL , 

2  AREAMX , WSURF , G IRTH , FBDZV , DBLWL , TLCB 

INTEGER  NSTATH.H0FSET(25) , NFREBD, NPTS 
CHARACTER*4  TITLE(20) 

REAL  X(25) ,Y(10.26) ,2(10.26) .FBDZV(8 , 10) ,LPP .BEAM , DBLWL , TLCB . 

2  draft , LCF , VCG .GM.DELCM .NEBLA , KPITCH .KROLL, KY AW .KYAWRL , AWP , VCB , 

2  FBDX(10),FBDY(10) ,FBD2(lO) ,XPT(10) .YPT( 10) , ZPT( 10) , LCB, GML. 

4  ASTAT(25) ,BSTAT(25) .MASS, DISPLM, IPITCH, IROLL, lYAW, 

6  IYaWkL , CHE AVE , CPITCH , CHEAP I , CROLL , AREAMX , WSURF , G I RTK ( 26 ) 

COMMON  /HULL/  A26 

COMMON  /INDEX/  PFIDX .LPFIDX .RMIDX.LRMIDX.SVIDX .LSVIDX 

INTEGER  LPFIDX, LRMIDX, LSVIDX 

REAL  PFIDX(236) .RMIDX(183) ,SVIDX(3) 

COMMON  /lO/  SYSFIL,POTFIL.COFFIL,LCOFIL,ICARD,TEXFIL,IPRIN, 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL .RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL , POTFIL . COFFIL , LCOFIL , ICARD , TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /LOADS/  NL0ADS,SWGHT(26) ,SMASS(26) ,XLDSTN(10) ,XLDXPT(25) , 
2  LSTATN(2B) 

COMMON  /PELEM/  PELEH 
COMPLEX  PELEM (4, 1000) 
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COMMON  /PHYSCO/  II , TPI , PI , PIOT .DEGKAD , RADDEG . VKMETR , METRVK ,GRAV . 

2  RHO , GNU , RHOS , RHOF . GNUS , GNUF . FTMETR , PUN  ITS . REYSCL 
COMPLEX  II 

REAL^TP I?PI , PIOT . DEGRAD , RADDEG . VKMETR , METRVK . GRAV , RHQ . GNU , RHOS , 

1  RHOF,  GNUS,  GNUF.  HMETR 

COMMON  /RDGEO/  BKLEN .MBKMAX ,DLBKEL(26) . SRBSC25 ) , PHIS(25 ) ,CPS(2S) . 

2  BKT(2S) ,RKS(25) .SSTR(25) 

COMMON  /RESPN/  NRESP , IPOINT( 182) , IMOTN( 182) , ITYPEC 182) . 

2  ILIN(182) ,ISYM(182) 

LOGICAL  ILIN.ISYM 

COMMON  /RLDBK/  PSUR(2S) ,BMK(25) ,DK(2S) ,CAK(25) .HQ.HSPAN  HMNCHD, 

2  HAREA,HXCP.HYCP,HZCP,HGAMHA,HYHAT.HEAR.HLCS,RQ(2) ,RpAN(^) , 

2  RMNCHDC2) ,RAREA(2) ,RXCP(2) .RYCP(25 .RZ^^Z) ,RGAMMA(2) ,RYHAT(^) . 

2  REAR(2) ,RLCS(2) ,SQ(2) ,SSPAN(2) ,SMNCHD(2) ,SAREA(2)  SXCP(2)  . 

2  SYCP(2) ,SZCP(2) ,SGAMMA(2) , SYHAT(2) . SEARC2) .SLCS(2 ) . BQ(2) , 

2  BSPAN(25  ,BMNCHD(2)  ,BAREA(2)  ,BXCP(25  ,BYp(25  ,BZCPp)  ,BGAMMA(*.)  . 

2  BYHAT(2)  ,BEAR(2)  ,BLCS(2)  ,FQ(2)  jF'SPAN(2)  ,FMNCHD(2)  FAREAU)  , 

'>  FXCP(2)  FyCP(2) ,F2CP(2) ,FGAMMAC2) ,FYHAT(2) .FEAR(2) .FLCS(^) , 

2  PQ(2;25:pS(2:2).PMNCHD(2,2),PAREAv2.2),PXCP(2  25.PYCP(2.2), 

2  PZCP(2,2) ,PGAMMA(2.2) ,PYHAT(2.2) ,PEAR(2,2) ,PLCS(2.2) , 

2  STADMP(1o5 ,SHPDMP( 10,8) .ENCON ,WPHI ,TPHI ,WMELM(4 , £>5 . SFELM (4 , 9 , 8) . 

2  REELM(4;9'8)VpEELM(4:9.8).FEELM(4,9,8).HEELM(4,9.85.BEELMC4,9.8), 

2  ENWM,ENSF(8,8) ,ENRE(8) .ENPE(8) ,ENFE£8) ,ENp(8) .ENBE(8). 

2  ENEMV(8,8) ,ENRL(8) ,ENPL(8) ,ENFL(8) .ENHL(8) ,ENSL(8; .tNBL(8) , 

2  ENSHP(8,8;:RELmU,9).ITS(2&),RD(25).EDDY(8.25),RGBi25) 

REAL  RDBLK(2692) 

EQUIVALENCE  (PSUR( 1 ) ,RDBLK( 1 ) ) 

COMMON  /SEVERE/  NRSIND .RSINDX .NSWIND  SUINDX ,RSVTOE,RV ,RH 
REAL  RSINOXCH)  .StfINDXCB)  ,RSVTQE(402) 

INTEGER  RV(13) ,RH(13) 

COMMON  /SMPSYS/  FIS .AS , SIS , SOS, SDS .HALOS, DEV ,PRN ,SMPPS, SMPIS , 

2  SMPOS , SMPDS , SHPTYPS , SHIPS , VARS , CYCLS , TITLES . OPTION , LSIS , LSOS , 

2  LSDS , LHALOS , LDEV , LF RN , LSMPPS , LSMPIS , LSMPOS , LSMPDS , LSHPTYPS . 

2  LSHIPS.LTITLES 
CHARACTER* 160  AS 

CHARACTER*80  FIS, SIS, SOS, SDS, TITLES 

CHARACTER*20  H AI.OS , DEV , PRN , SHPPS , SMPIS , SMPOS .SMPDS , SHPTYPS 
CHARACTER  SHIPS*6 , VARS*2 ,CYCLS*2 
INTEGER*2  OPTION 

COMMON  /STATE/  LAT.VRT.LOADS, ADORES, SALT, HEAD, EXROLL, BKEEL 
LOGICAL  LAT , VRT , LOADS . ADORES , SALT , HEAD , EXROLL , BKEEL 

COMMON  /STELEM/  STELEM 
COMPLEX  STELEM (4,9,280) 

COMMON  /TELEM/  TELEM 
COMPLEX  TELEM(4,9,10) 

COMMON  /TWOD/  YY,  ZZ,  ENN,  ISTA 

™YY(io!2B)  .ZZ(  10, 26)  .ENN (4, 10,26) 

COMMON  /WGHTS/  WTDL.NORM 
REAL  tfTDL(10,25),NORM(4,10,25) 

CHARACTER*20  DS,TS,ES,T1S,T2S 


*  START 


♦  set  underiioH  xo  zero 

*  CALL  UNDERO  ( .TRUE.) 
CALL  UNDFL  (.TRUE.) 
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AS- ‘CLS’ 

CALL  SYSTEM  (AS) 

CALL  PRELIM 

CALL  RDSMPSYS 

FIS  =  S0S(1;LSQS)//’ .TEX’ 

OPEN  (TEXFIL, riLE=FIS,FORM=’ FORMATTED ST ATUS=’ UNKNOWN ’ ) 

AS  =  ’ (/19X, "STANDARD  SHIP  MOTION  PROGRAM,  SMPe3"/2SX , ’ // 
'"FOR  PERSONAL  COMPUTERS")' 

WRITE  (^.AS) 

WRITE  (TEXFIL.AS) 

AS  =  ’(/28X."DTRC  CODE  1561")' 

WRITE  (♦,AS) 

WRITE  (TEXFIL.AS) 

CALL  DATE  (DS) 

AS  =  ’ (//28X,"DATE  =  ",A20)’ 

WRITE  (*,AS)  DS 
WRITE  (TEXFIL.AS)  DS 

CALL  TIME  (TS) 

T1S=TS 

AS  =  ’ (/28X,"TIME  =  ",A8)  ' 

WRITE  (*.AS)  TS 
WRITE  (TEXFIL.AS)  TS 

AS  =  ' (//2X , "Running  -  ")' 

WRITE  (*.AS) 

WRITE  (TEXFIL.AS) 

AS  =  '(//"  CALL  INPUT")’ 

WRITE  (*.AS) 

WRITE  (TEXFIL.AS) 

CALL  INPUT 

C.”L  TIME  (T2S) 

CALL  ELTIME  (T1S.T2S) 

T1S=T2S 

IF  (OPTN  ,EQ.  1)  GO  TO  10 

AS  =  ’(//"  CALL  REGWAV")’ 

WRITE  (♦.AS) 

WRITE  (TEXFIL.AS) 

CALL  RF.GWAV 

CALL  TIME  (T23) 

CALL  ELTIME  (T1S.T2S) 

T1S=T2S 

AS  =  ’(//"  CALL  IRGSEA")’ 

WRITE  (♦.AS) 

WRITE  (TEXFIL.AS) 

CALL  IRGSEA 

CALL  TIME  (T2S) 

CALL  ELTIME  (T1S,T2S) 

T1S=T2S 

AS  =  ’(//"  CALL  OUTPUT")’ 

WRITE  (♦.AS) 

WKiie.  viEXrlL.AS) 


CALL  OUTPUT 


CALL  TIME  (T2S) 

CALL  ELTIME  (TlS,T2S) 


•  QUIT 


10  CONTINUE 

AS  =  ’ (//2X ."Finished  !  ")' 
WRITE  (*.AS) 

WRITE  (TEXFIL.AS) 

CALL  TIME  (ES) 

CALL  ELTIME  (TS.ES) 

CLOSE  (UNIT=TEXFIL) 

CLOSE  0)NIT=IPRIN) 

STOP 

END 


c  <^nT  \7F 

SUBROUTINE  SOLVE  (N.COFF.EXC, 


MQTN.UL.IP.IPRIN) 


*  This  routine  obtains  a  solution  of  the  lateral  or  vertical 

*  equations  of  notion. 

*  W.G. MEYERS,  DTNSRDC,  072977 


COMPLEX  CQFF.EXC.MOTN.UL 
INTEGER  N  IP 

dihensiqn’coff(n,n) ,EXC(N) ,M0TN(N) ,UL(N,N) 

DIMENSION  IP(N) 

CALL  CDCCKF(K,K.CCrF,UL,ir) 

IF  (IP(N)  .EQ.  0)  WRITE  (IPRIN.lOOO) 

1000  FORMAT  (42H  SOLVE  —  PROGRAM  STOP.  MATRIX  SINGULAR) 

IF  (IP(N)  .Eq.  0)  STOP 

CALL  CS0LVE(N,N,UL,EXC,M0TN,1P) 

RETURN 

END 

C  DECK  SPFIT 

SUBROUTINE  SPFIT  (X.  Y,  ELEHS,  NPTS) 

•  SPFIT  created  from  SPLINE  E  N  HUBBLE  JUNE  19 

•  fits  cubic  non-paranetric  spline  segiiiento 

e  to  set  of  real  data  points 


array  of  real  independent  variables 
array  of  real  dependent  variables 
number  of  (X,Y)  data  points 


array  of  (NPTS-1)  segments  in  following  form 
(  Y(I),  D(I),  Y(I+1).  D(I+1)  )  ,  where 

array  of  second  derivatives  at  data  points 


*  NPTS  = 

*  RETURN 

♦  ELEMS  = 

♦  D  - 


1^ 

* 

*■ 

* 


arrays  A  B,C  are  mainly  sub  diag. ,  diagonal,  and  super  diag. 

D  array  is  the  right  hand  side  of  matrix  equation 

second  derivatives  at  nodes  are  placed  in  D  array  after  solution 

solution  technique  is  gaussian  elimination 

boundary  conditions  set  by  extrapolation  of  second  derivatives 
COMMON  /lO/  SYSFIL.POTFIL,COFFIL,LCOFIL,ICARD,TEXFIL,IPRIN, 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL, SEVFIL , SPDFIL , 

■)  CPTFTI  T.ACFTT ..I.AF.FIL 

"  INTEGER  SYSFIL,POTFIL,COFFIL,LCOFIL,ICARD.TEXFlL.lPHiN, 

2  SCRFIL, HPLFIL, LRAFIL, ORGFIL, RAOFIL, RMSFIL, SEVFIL, SPDFIL, 


/ 


2  SPTFIL.LACFIL.LAEFIL 

DIMENSION  X(NPTS) .Y(NPTS).ELEMS(4,KPTS) 

DIMENSION  AClOO),  BClOO),  0(100),  D(IOO) 

N  =  NPTS 
NLl  =  N  -  1 
NL2  =  N  -  2 
DO  SO  1  =  2, N 

IF  (X(I)  .GT.  X(I-l))  GO  TO  50 
WRITE  (IPRIN,888)  X(I-1),X(1) 

GO  TO  88688 
50  CONTINUE 

IF  (N  -LE.  100)  GO  TO  100 
WRITE  (1PRIN,999) 

N  =  100 

100  CONTINUE 

IF  (N  .GT.  2)  GO  TO  l25 
D(l)  =  0.0 
D(2)  =  0.0 
GO  TO  .T76 
125  CONTINUE 

IF  (N  .GT.  3)  GO  TO  150 

YDD  =  2.*((X(3)-X(2))*Y(1)+(X(2)-X(1))*Y(3)-(X(3)-X(1))»Y(2)) 
2  /((X(3)-XC2))*(X(2)-X(1))»(X(3)-X(1))) 

DU)  =  YDD 
D(2)  =  YDD 
D(3)  =  YDD 
GO  TO  375 
160  CONTINUE 

DO  200  I*=l  ,N 
A(I)  =  0.0 
B(I)  =  0.0 
C(I)  =  0.0 
D(I)  =  0.0 
200  CONTINUE 

♦  «i«t  up  matrices (&  tridiagon.al  structure) 

A(l)  =  (X(3)-X(2))/(X(3)--X(1)) 

C(l)  =  2.0 
B(l)  =  1.0  -  A(l) 

D(l)  »  6.0*((Yb)-Y(2))/(X(3)-X(2))-(Y(2)-Y(l))/ 

1  (X(2)-X(1)))/(X(3)-X(1)) 

H  =  X(3)  -  X(2) 

DO  250  1=3, BLl 
HP  =  X(I+1)  -  X(I) 

C(I)  =  HP  /  (H+HP) 

B(I)  =  2.0 
A(I)  =  1.0  -  C(I) 

DU)  -  6.0^((Y(I+1)-Y(I))/HP-(Y(I)-Y(I-1))/H)/(HP+H) 

H  =  RP 

250  COKTIBUE 


set  boundary  conditions 

:  (X(2)-X(1))/(X(3)-X(2)) 

1.0 

-1.0-C(2) 

0.0 

-A(2)*A(1)/B(1)  +  C(2) 
(X(H)-X(N“i))/(X(H-l)-X(N-2)) 
-1.0  -  CCS) 

1.0 
0.0 


*  solve  equations 

11  =  1 

DO  300  1=1, KL2 
I  i  -  1  1 

12  =  I  +  2 
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AUGH  =  ABS  (B(I)) 

IF  (AUGH  .LT.  l.OE-06)  GO  TO  27S 
CONST  =  A(I1)  /  B(I) 

B(I1)  =  B(I1)  -  C0N3T*C(I) 

D(I1)  =  D(I1)  -  CONST*D(I) 

IF  (1  .NE.  NL2)  GO  TO  300 
A(N)  =  A(N)  -  C(HJfC(I)  /  B(n 
D(N)  =  D(N)  -  CCH)+D(1)  /  B(I) 

GO  TO  300 
275  CONTINUE 

II  =  I  +  1 
D(I)  =  D(I)  /  C(I) 

D(I1)  =  D(I1)  -  B(I1)+D(I) 

B(I1)  =  A(I1) 

A(I1)  =  0.0 

D(12)  =  D(I2)  -  A(I2)*D(I) 

A(I2)  =  0.0 

IF  (I  .NE.  NI.2)  GO  TO  300 
A(N)  =  C(N) 

300  CONTINUE 

DET  =  B(NL1)*B(N)  -  C(NL1)*A(N) 

STORE  =  D(N) 

D(N)  =  (B(;nL1)*D(H)  -  D(NL1)*A(N))  /  DET 
D(NL1)  =  (D(NL1)*B(K)  -  C(NL1)+ST0RE)  /  DET 
IP  =  0 

DO  3S0  1=2, NL2 
JI  =  N  -  1 

IF  (JI  .EQ.  IP)  GO  TO  3.50 
IF  (JI  .EQ.  II)  GO  TO  325 
D(JI)  =  (D(JI)-C(JI)*D(JI+1))/B(JI) 

GO  TO  350 
325  CONTINUE 

IP  =  JI-1 
STORE  =  D(JI) 

D(JI)  =  D(IP) 

D(IP)  =  (STORE  -  C(IP)*D(JI+1))/B(IP) 

350  CONTINUE 

D(l)  =  (D(l)  -  A(1)*D(3)  -  C(1)'*D(2))  /  B(l) 

*  set  up  spline  segments 

375  CONTINUE 

DC  400  1=1, NLl 
II  =  I  +  1 
ELEHS(1,I)  =  Y(I) 

ELEMS(2.I)  =  D(I) 

ELEMS(3,I)  =  Y(I1) 

ELEMS(4.I)  =  D(I1) 

400  CONTINUE 
99999  CONTINUE 

RETURN 

88B88  CONTINUE 
STOP 

888  FORMAT  (’0  SPFIT  —  X  VALUES  NOT  ASCENDING',  2E16.8) 

999  FORMAT  (’0  SPFIT  —  NPTS  EXCEEDS  100.  ONLY  99  SEGMENTS  RETURNED’) 

END 

C  DECK  SPIHT2 

SUBROUTINE  SPINT2  (SEGS,  NSEGS.  AREA.  NS,  TS.  NE,  TE,  IWAY) 

♦  evaluates  the  integral  ol  a  function  given  as  &.  parametric  spline 

*  INPUTS 

♦  SEGS  =  .'spline  segements  generated  by  SPLNT2 

e  NSEGS  =  nsunber  of  spline  segments 

*  KS  =  index  of  segment  for  start  of  integration 

♦  TS  =  t  parameter  for  start  of  integration 

*  HE  =  index  nf  eegmant  for  end  of  integration 

♦  TE  =  t  peu:2uneter“  for  end  of  integration 
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*  IWAY  =  -1  ,  if  integral  of  y  dx  is  to  be  evaluated 

*  IWAY  =  0  ,  if  integral  of  x  dy  is  to  be  evaluated 

♦  RETURN 

•  AREA  =  INTEGRAL  (AREA  UNDER  CURVE)  FROM  (NS+TS)  TO  (NE+TE) 

COMMON  /lO/  SYSPIL,P0TFIL,C0FFIL,LC0FIL,1CARD,TEXFIL,IPRIN, 

2  SCRFIL , HPLFIL , LRAr IL . ORGFIL , RAOFIL .RMSFIL , SEVFIL, SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL . PQTFIL , COFFIL . LCOFIL , ICARD . TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL , SEVFIL . SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

DIMENSION  SEGS(8.NSEGS) .CC(14) .T(2).A(2) 

AREA  =0.0 

IF  (NS.GE.l  .AND.  NS.LE.NSEGS)  GO  TO  100 
WRITE  (IPRIN. 991)  NS 
GO  TO  99999 
100  CONTINUE 

IF  (NE.GT.NS  .AND.  NE.LE.NSEGS)  GO  TO  150 
WRITE  (IPRIN. 992)  NE 
GO  TO  99999 
150  CONTINUE 

IF  (TS.GE.0.0  .AND.  TS.LE.1.0)  GO  TO  200 
WRITE  (IPRIN. 993)  TS 
GO  TO  99999 
200  CONTINUE 

IF  (TE.GE.0.0  .AND.  TE.LE.1.0)  GO  TO  250 
WRITE  (IPRIN. 994)  TE 
GO  TO  99999 
250  CONTINUE 

IF  (IWAY  .EQ.  0)  GO  TO  350 
K  =  1 
J  =  2 
GO  TO  400 
360  CONTINUE 

K  =  2 
J  =  1 

400  CONTINUE 

.12  =  J  +  2 
J4  =  J  +  4 
.16  =  J  +  6 
K4  =  K  +  4 
K8  =  K  +  8 
KIO  =  K  +  10 
DO  600  I=NS,NE 
T(l)  =  0.0 
T(2)  =  1.0 

IF  (I  .EQ.  NS)  T(l)  =  TS 

IF  (I  .EQ.  NE)  T(2)  =  TE 

CALL  CUBC02  (SEGSd.I).  CC) 

DDl  =  (CC( j)*CC(K8)5  /  6.0 

DD2  =  (CC(J)*CC(K10)  +  CC(J2)*CC(K8))  /  B.O 

DD3  =  (CC(J  )*CC(K4)  +  CC( J2)*CC(K10)  +  CCd4)*CC(K8) )  /  4.0 

DD4  =  (CC(J2)*CC(K4)  +  CC( J4)*CC(K10)  +  CC(J6)*CC(K8) )  /  3.0 

DD5  =  (CC(J4)+CC(K4)  +  CC( J6)+CC(K10))  /  2.0 

DD6  =  CC(J6)*CC(K4) 

DO  560  L=1.2 

IF  (T(L)  .GT.  0.0)  GO  TO  460 
A(L)  =  0.0 
GO  TO  660 
450  CONTINUE 

IF  (T(L)  .LT.  1.0)  GO  TO  600 
A(L)  =  DDl  +  DD2  +  DD3  +  DD4  +  DD5  +  DD6 
GO  TO  550 
600  CONTINUE 

A(L)  =  (((((  DDl  ■*  T(L)  +  DD2)  •  T(L)  +  DD3)  *  T(L)  +  DD4) 

2  ♦  T(L)  +  DD6)  *  T(L)  +  DD6)  *  T(L) 

650  CONTINUE 

AREA  =  AREA  +  A(2)  -  A(l) 

600  CONTINUE 
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99999 

CONTINUE 

RETURN 

991 

FORMAT 

(’0 

SPINT2 

—  NS 

992 

FORMAT 

(’0 

SPINT2 

—  NE 

993 

FORMAT 

^o 

SPINT2 

—  TS 

994 

FORMAT 

CO 

SPINT2 

—  TE 

END 


,  15,  *  OUT  OF  RANGE’  ) 

,  15,  '  OUT  OF  RANGE’  ) 

.  E12.5,  ’  OUT  OF  RANGE’  ) 

,  E12.5.  ’  OUT  OF  RANGE'  ) 


C  DECK  SPTNTG 

SUBROUTINE  SPINTG  (XA,  XB,  X,  NPTS,  ELEMS,  A,  CINTG,  SINTG) 


uiio  ax  W4.  c*.  w  - -j 

non-parainetric  spline  segments 

=  lower  limit  of  integration 
=  upper  limit  of  integration 
=  array  of  independent  variables 
=•  number  of  values  in  x-array 

=  non-pavametric  spline  segments  generated  by  SPFIT 
=  constant  for  specific  integral  to  be  evaluated 


* 

SPINTG 

♦ 

evaluates 

* 

* 

INPUTS 

* 

XA 

XB 

X 

* 

NPTS 

ELEMS 

A 

*♦5 

RETURNS 

If 

CINTG 

If 

SINTG 

# 

IF  A 

=  INTEGRAL  OF  FCX)  i-  COS(A*X) 

=  INTEGRAL  OF  F(X)  •  SIN(A^X) 

=  0.0  .  THEN  CINTG  =  INTEGRAL  OF  F(X) , 


SINTG 


DIMENSION  X(NPTS) ,ELEMS(4,NPTS) 


100 


200 


300 


400 


CINTG  =  0.0 
SINTG  =  0.0 

CALL  SPLVAL  (X,  NPTS,  ELEMS,  XA 

CALL  SPLVAL  (X,  NFTS,  ELEMS,  XB 

A2  =  A  *  A 

A3  =  A  *  A2 

A4  =  A  ♦  A3 

DO  BOO  I=IA,IB 

IF  (I  .GT.  lA)  GO  TO  100 

XI  =  XA 

X2  =  X(I+1) 

Y1  =  YA 

Y2  =  ELEMS(3,I) 

51  =  SA 

52  =  ELEMS(4,I) 

GO  TO  300 
CONTINUE 

IF  (1  .LT.  IB)  GU  TU  200 
XI  =  X(I) 

X2  =  XB 

Y1  =  ELEMS(1,I) 

Y2  =  YB 

51  =  ELEMS (2, I) 

52  =  SB 
GO  TO  300 
CONTINUE 
XI  =  X(I) 

X2  =  X(I+1) 

Y1  =  ELEMS(1,I) 

Y2  =  ELEMS (3, I) 

51  =  ELEMS(2,I) 

52  =  ELEMS (4, I) 

CONTINUE 

XX  =  X2  -  XI 

IF  (A  .NE.  0.0)  GO  TO  400 
SRGTNT  =  fY2+Yl)  XX  /  2.  - 

CINTG  =  CINTG  +  SEGIHT 
GO  TO  500 
CONTINUE 


YA,  SA,  lA) 

YB,  SB,  IB) 


(S2+S1)  *  XX*'»3  /  24. 
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ZAA  =  (S2-S1)  /  (XX  *  6J 
ZBB  =  SI  /  2. 

zee  =  (Y2-Y1)  /  XX  -  (S2  +  2. *51)  ♦  XX  /  6 . 

AXX  =  A  ♦  XX 
E  =  SIN  (AXX) 

F  =  CCS  (AXX) 

XX2  =  XX  •  XX 
XX3  =  XX  *  XX2 

P  =  (3.*A2+XX2  -  6.)  /  A4 

0  =  (A2*XX3  -  6.*XX)  /  A3 

AAl  =  F*P  +  E*q  +  6./A4 

AA2  =  E*P  -  F+q 

PP  =  (2.*XX)  /  A2 

qq  =  (A2*XX2  -  2.)  /  A3 

BBi  =  F+pp  +  E+qq 

BB2  =  E*PP  -  Ft-qq  -  2./A3 

XXA  =  XX  /  A 

CCl  =  (F-l.)/A2  +  E*XXA 

CC2  =  E/A2  -  F*XXA 

DDl  =  E/A 

DD2  =  (l.-F)/A 

AXl  =  A  ♦  XI 

VV  =  COS  (AXl) 

UU  =  SIN  (AXl) 

PPP  =  (AA1*2AA  +  BBl+ZBB  +  CC1*ZCC  +  DD1*Y1) 

qqq  =  (aaz+zaa  +  bb2»zbb  +  ccz-fzcc  +  dd2*yi) 

sisEG  =  uu*ppp  +  vv*qqq 

cisEG  =  vv*ppp  -  uu»qqq 

CINTG  =  CINTG  +  CISEG 
SINTG  =  SINTG  +  SISEG 
SOO  CONTINUE 

RETURN 

END 

C  DECK  SPLNAR 

SUBROUTINE  SPLNAR  (P.NPTS.SPAREA.PSEGS.NS) 

COMMON  /lO/  SYSFIL.POTFIL.COFFIL.LCOFIL.ICARD.TEXFIL.IPRIN, 

2  SCRFIL , HPLFIL , LR AFIL , ORGFIL . RAOFIL .RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL , POTFIL . COFFIL , LCOFIL , ICARD , TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL . ORGFIL . RAOFIL .RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

DIMENSION  P(2,i0) ,PSEGS(8,9) 

DIMENSION  NDI(2),ENDI(2,2) 

DATA  ZERO, ONE  /O. 0,1.0/ 

DATA  NDI.ENDI  /2+1,4’fO.O/ 

CALL  SPLNT2  (PSEGS ,P ,NPTS ,NDI .ENDI) 

CALL  SPINT2  (PSEGS, NS. SPAREA.l, ZERO, NS, ONE. 0) 

RETURN 

END 

C  DECK  SPLNFT 

SUBROUTINE  SPLNFT 

*  routine  used  -o  write  ollsots  to  HPLFIL  lor  graphics 

COMMON  /DATINP/  OPTN.HOTN ,BSCFIL,VLACPR.RAOPR.RLDMPR,DISPLMT, 
2  LRAOFR , ADRPR , ORGOPTN , CMNOM , KG .STATN (2B) , NSOFST ( 26 ) . 

2  NLEWF(2B) ,HLFBTH(10,26) ,WTRLNE(10 ,26) .BLEWF(2B) ,TLEWF(2B) , 

2  AaEALF(26) ,NPTL0C,PTNUMB(10) ,PTNAHE,XPTL0C(10) ,YPTLOC(lO) , 

2  ZPTLOCUO) ,NBB,FBNUHB(10) ,FBNAME,XPTFBD(10) ,YPTFBD(10) , 

2  ZPTFBD ( 10 ) , FBCODE ( 10 ) , FBTYPE , ROOT ( 10 ) , VKDES . FNDES , 

2  STATNM.STATIS 

CHARACTER*4  PTNAME(b , lO) ,FBr«AHE(6 , 10) ,5TATKK(B) .FETYPECS ,10) 
INTEGER  DPTN , MOTN , BSCFIL , VLACPR, RAOPR , ADRPR , RLDMPR , FBCODE , 

2  FBHUMB.PTNUMB, ORGOPTN 
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REAL  KG 


COMMON  /GEOM/  X , NSTATN , Y ,Z , NQFSET ,LPP , BEAM .DRAFT , LCF , 

1  VCG , GM , DELGM , NEBLA . KPITCH , KROLL , KY AW , KYAWRL , AWP , VCB , FBDX , FBD Y , 

2  FBDZ , NFREBD , XPT . YPT , 7.PT ,  NPTS , LCB , GML ,  ASTAT ,  BSTAT , TITLE , H ASS , 

2  DISPLM.IPITCH, TROLL, lYAW.IYAWRL.CHEAVE.CPITCH.CHEAPI.CROLL, 

2  AREAMX , WSURF .GIRTH . FBDZV  JIBLUL ,TLCB 

INTEGER  NSTATN, NQFSET(25) .NFREBD, NPTS 
CHARACTER*4  TITLE(20) 

REAL  X(25) .Y(10,25)  ,7(10,25) ,FBDZV(8 , 10) ,LPP .BEAM .DBLWL.TLCB , 

2  DRAFT, LCF, VCG, GM, DELGM, NEBLA, KPITCH, KROLL. KYAW, KYAWRL, AWP ,VCB, 

2  FBDX(10),FBDY(10) ,FBDZ(10) ,XPT(10) ,YPT(10) ,ZPT(10) , LCB, GML, 

4  ASTAT (26 ) , BSTAT (25 ) , MASS ,D tSPLM . IPITCH .TROLL , I YAW , 

6  I YAWRL , CHEAVE , CPITCH , CHEAPI . CROLL , AREAMX , WSURF , GIRTH ( 25) 

COMMON  /TO/  SYSFIL.POTFIL.COFFIL.LCOFIL.ICARD.TEXFIL.IPRIN, 

2  SCRFIL , HPLFIL , LRAFTL , QRGFIL , RAOFIL .RMSFIL . SEVFIL , SPDFIL , 

2  SPTFTL.LACFIL.LAEFIL 

INTEGER  SYSFIL.POTFTL.COFFIL.LCOFIL.ICARD.TEXFIL.IPRIN. 

2  SCRFIL . HPLFIL , LRAFIL , ORGFIL , RAOFIL .RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /PHYSCO/  II ,TPI ,PI . PIOT, DEGRAD .RADDEG .VKHETR.METRVK ,GRAV , 
2  RHO . GNU . RHCS , RHQF , GNUS , GNUF , FTMETR , PUN ITS , REYSCL 
COMPLEX  II 

CHARACTER*4  PUNITS(2) 

REAL  TPI , PI . PIOT , DEGRAD . RADDEG . VKMETR , METRVK , GRAV , RHO , GNU , RHOS , 

1  RHOF, GNUS. GNUF, FTMETR 

COMMON  /SMPSYS/  FIS , AS .SIS , SOS. SDS .HALOS, DEV ,PRN .SMPPS ,SMPIS . 

2  SMPQS . SMPDS , SHPTYPS .SHIPS , VARS , CYCLS .TITLES , OPTION , LSIS . LSOS , 

2  LSDS,LHALOS,LDEV,LPRN,LSMPPS,LSMPIS,LSMPOS,LSMPDS,LSHPTYPS, 

2  LSHIPS.LTITLES 
CHARACTER* 160  AS 

CHARACTER+80  FIS , SIS , SOS , SDS .TITLES 

CHARACTER*20  HALOS , DEV , PRN , SHPPS , SMPIS , SMPOS , SMPDS , SHPTYPS 
CHARACTER  SHIPS*6.VARS*2,CYCLS*2 
INTEGER*2  OPTION 

DIMENSION  P(2,10) ,PSEGS(8.9) ,CC(14) ,AY(900) , AZ(900)  , 

2  HFB(10,26) ,WTR(10,28),NDI(2),ENDI(2,2) 

CHARACTER*6  SNAME(6) 

CHARACTER*80  ATITL 
CHARACTER  STSP*30 

DATA  SKAME  /’YFHD’ , 'ZFWD', ’YAFT’ , ’ZAFT’ , ’HLFBTH’ , ’WTRLNE'/ 

DA^A  KDl.ENDI  /2*1, 4*0.0/ 

DO  30  K=1 , NSTATN 
NPTS  =  NSUFST(K) 

DO  10  1=1, NPTS 
HFB(1,K)  =  HLFBTH(I,K) 

WTR(I.K)  =  WTRLNE(I,K) 

10  C3VT1NUE 

IF  (f’FTS.EQ.  1  .AND.  STATN (K) . GT. 10. 0)  HFB(l,K)  =  -  EFB(l,K) 

HPT  =  10  ~  NP'^S 
IF  (HPT  .EQ.  0)  GO  TO  30 
DO  20  I-l.rtPT 
IPT  =  T  +  NPTS 
HFB(tPT,K)  =  MFE(NPTS,K) 

UTRaPT.K)  -  WTR(HPTS,K) 

20  CONTINUE 
30  CONTINUE 
DX  =  LPP/20 

WRITE(S75P , 1000)  DX ,PUNITS( 1 ) ,PUNITS(2) 

1000  FORMAT  ('STATION  SP.ACING  ,F6.2,1X,A4,A2) 

WR1TE(ATITL,1010)  TITLE 
1010  FORMAT  (2.0A4) 


*  open  file  lor  hul.l  olls'it  plotting 
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1020 

1030 

40 


50 


60 

70 

100 


210 

110 

104u 

1060 

1060 

220 

120 

230 

130 


FIS  =  SDS(1 :LSDS)//' .HPL’ 

OPEN  (UNIT=HPLFIL ,FILE=F1S , STATUS= ’UNKNOWN ’ ) 

WRITE  (HPLFIL,1020)  ATITL 
FORMAT  (A80) 

WRITE  (HPLFIL,1030)  STSP 
FORMAT  (A30) 

NOS  =  10 

L  =  0 

KOUNT  =  0 

IK  =  KOUNT  +  1 

DO  100  K=IK,NSTATN 

KOUNT  =  KOUNT  +  1 

NPTS  =  NSOFST(K) 

IF  (NPTS  .EQ.  1)  GO  TO  100 
L  =  L  +  1 
AY(L)  =  0. 

AZ(L)  =  WTR(NOS,K)  -  DRAFT 
DO  50  Jr:l,KOS 

IF  (STATN(K)  .GT.  10.0)  HFB(J,K)  =  -  HFB(J,K) 
WTR(J,K)  =  WTR(J,K)  -  DRAFT 
PCl.jj  =  HFBCJ.K) 

P(2.J)  =  WTRU.K) 

CONTINUE 
NS  =  NOS  -  1 

CALL  SPLNT2  (PSEGS .P.NQS.NDI ,ENDI) 

DO  70  J=1 ,KS 

CALL  CUBC02  (PSEGS( 1 . J ) .CC) 

NT  =  7 

DT  =  l./(NT-l) 

DO  60  1=1, NT 
L  =  L  +  1 
T  =  (I-1)*DT 
T2  =  T*T 
T3  =  T*T2 

AY(L)  =  CC(1)*T3  +  CCC3)*T2  +  CC(6)*T  *  CC(7) 
A2(L)  =  CC(2)*T3  +  CcU)*T2  +  CCCoWt  +  CC(8) 
CONTINUE 
CONTINUE 

IF  (STATN(K)  .EQ.  10.0)  GO  TO  110 
CONTINUE 


WRITE  (;hPLFIL,1040)  SNAME(3),SNAME(4) 
WRITE  (HPLFIL,1060)  L 
DO  210  1=1, L 

WRITE  (HPLFIL.lOeO)  AY(1),AZ(I) 

CONTINUE 

GO  TO  120 


WRITE  (HPLFIL.1040)  SNAKE(l) ,SNAME(2) 
FORMAT  (A6,4X.A6) 

WRITE  (HPLFIL.IOBO)  L 
FORMAT  (218) 

DO  220  1=1, L 

WRITE  (HPLFIL,1060)  AY(I),AZ(I) 
FORMAT  (10F7.2) 

CONTINUE 
L  =  0 
GO  TO  130 


WRITE  (HPLFIL,i04D)  SNAME(6) .SNAME(6) 
WRITE  (HPLFIL,1060)  NOS.NSTATN 
DO  230  K=1,NSTATN 

WRITE  (HPLFIL,1060)  (HFB(I ,K) ,1=1 ,KOS) 
WRITE  (HPLFIL,1060)  (WTR(I ,K) ,1=1 .NOS) 
CONTINUE 

IF  (KOUNT  .LT.  NSTATN)  GO  TO  40 
CLOSE  (UNIT=HPLFIL) 

RETURN 
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END 


C  DECK  SPLNT2 

SUBROUTINE  SPLNT2  {  SEGS,  P.  NP ,  NDI,  ENDI  ) 

-f  SPLNT2  created  Irom  SPENT  (  NAVSEC-NOOO  )  -  A  H  REED  JULY  1976 

*  lies  cubic  parametric  spline  segments  through  set  of  data  points 

*  INPUTS 

*  P  = 

*  NP  = 

NDiCl) 

+  NDI(l) 

*  NDI(2)  = 

*  NDI(2)  = 

*  ENDI (1,1)  = 

*  ENDI(2,1)  = 

*  ENDI (1,2)  = 

*  ENDI(2,2)  = 

*  RETURNS 

*  SEGS  =  array  ol  (NP-1)  segments  in  endpoint/temgen-:’  form 

*  X(I),Y(I)  .DX(I)  ,DY(I)  ,X(I  +  1)  ,Y(I  +  1)  ,DX(I+l),DU'i  +  l) 

COMMON  /IQ/  sysfil,potfil,cqffil,lcqfil,icard,texfil,iprin, 

2  SCRFIL , EPLFIL , LRAF IL , ORGFIL , RAOFIL , RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL,LACFIL,LAEFIL 

INTEGER  SYSFIL , POTFIL , COFFIL .LCDFIL , ICARD , TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL , RMSFIL , SEVFIL , SPDFIL . 

2  SPTFIL,LACFIL,LAEFIL 

DIMENSION  SEaS(8,NP)  ,P(2  ,;iP)  ,NDI(2)  ,ENDI(2,2) 

DIMENSION  DS(2.70) ,1HDEX(70) ,R1(70) ,R2(70) .R3(70) ,R4(70) , 

2  CS(T0),T10C2) ,T21(2) 

DATA  TIO  /  1.0,  0.0  /, 

1  T21  /  2.0,  1.0  / 

*  initialize  segs  array,  determine  deltas,  chord  lengths  and 

*  indices  ol  non-zero  length  segments. 

M  =  1 
N  =  HP 
HI  =  N  -  1 

IF  (HI  .LE.  69)  GO  TO  1000 
HI  =  69 

WRITE  (IPRIH,999) 

1000  CP  =  0.0 

DO  1120  J  =  1,  HI 
INDEX(J)  =  J 
C  =  0.0 

DO  1100  I  =  1,  2 
PI  =  P(I,J) 

P2  =  P(I,J+1) 

DELTA  =  P2  -  PI 
C  =  C  +  DELTA *DELTA 
DS(I,M)  =  3.0->DELTA 
SEGS(I,J)  =  PI 
SEGS(I+4,J)  =  P2 
SEGS(I+2,J)  =  DELTA 
SEGS ( 1+6, J)  =  DELTA 
1100  CONTINUE 

IF  (C  .LE.  0.000001)  GO  TO  1110 
C  =  SQRTC  C  ) 

CS(M)  =  C 
R1(M)  =  C 
R3(M)  =  CP 
IHDEX(M)  =  J 
M  -  M  +  1 
CP  =''c 


array  ol  (X,Y)  points 
number  ol  points 

1,  il  initial  slope  not  specified  at  first  point 

2,  il  initial  slope  is  specified  at  first  point 

1,  il  initial  slope  not  specified  at  final  point 

2,  if  initial  slope  is  specified  at  final  point 

DX/DT  at  first  point  —  not  required  if  NDI(1)=1 

DY/DT  at  lirst  point  —  not  required  if  NDI(l)=l 

DX/DT  at  final  point  —  not  required  if  NDI(2)=1 

DY/DT  at  final  point  —  not  required  if  NDI(2)=1 
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1 


1110  CONTINUE 
1120  CONTINUE 
N  =  « 

H  =  N  -  1 

*  check  for  degenerate  case  (only  2  points) 

IF  (N  .GT.  2)  GO  TO  1300 

*  degenerate  case,  set  single  segment  tangent  vectors. 

J  =  INDEX(l) 

C  =  CS(1) 

DO  1240  1=1,  2 


IF  ( 

;  NDi(i; 

)  .GT.  1  ; 

)  SEGSI 

;i+2,J) 

=  ENDK 

ji.i; 

IF  ( 

’  NDI(2, 

)  .GT.  1  , 

)  SEGSI 

!i+6,j) 

=  ENDK 

;i,2! 

)*C 

1240  CONTINUE 

GO  TO  99999 
1300  CONTINUE 

*  set  end  conditions  of  tri-diagonal  matrix 

I  =  NDI(l) 

R2(l)  =  T21(I) 

R3(l)  =  TlO(l) 

I  =  NDI(2) 

R1(N)  =  TIO(I) 

T2  =  T21(I) 

*  solve  matrix  lor  tangent  vectors 

DO  1340  1=1,2 
R4(l)  =  DS(I,1)/CS(1) 

IF  (  NDI(l)  .GT.  1  )  R4(l)  =  ENDI(I,1) 

DO  1315  J  =  2,  K 
R  =  CS(J-1)/CS(J) 

R2(J)  =  2.0*(CS(J)  +  CS(J-l)) 

R4(J)  =  DS(I,J)eR  +  DS(I,J-1)/R 
1316  CONTINUE 
R2(N)  “  T2 

R4(N)  =  DS(I,M)/CS(M) 

IF  (NDI(2)  .GT.  1)  R4(H)  =  EKDI(I,2) 

DO  1330  J  =  1,  K 
R  =  R1(J+1)/R2(J) 

R2(J+1)  =  R2(J+1)  -  R3(J)*R 
R4(J+1)  =  R4(J+1)  -  R4(J)+R 
1330  CONTINUE 

DN  =  R4(N)/R2(N) 

DO  1336  L  =  1.  M 
J  =  N  -  L 
K  =  INDEX(J) 

DJ  =  (R4(J)  -  R3(J)*DN)/R2(J) 

SEGS{I+2,K)  =  DJeCSl'J) 

SEG3(I+6,K)  =  DN*CS(J) 

DN  =  DJ 

1335  CONTINUE 
1340  CONTINUE 
99999  CONTINUE 

RETURN 

999  FORMATC’O  SPLNT2  —  NP  EXCEEDS  70.  ONLY  69  SEGMENTS  RETURNED.’) 
END 


C  DECK  SPLVAL 

SUBROUTINE  SPLVAL  (X,  KPTS,  ELEMS,  XO, 


YO,  SO,  lELM) 


*  SPLVAL  created  from  SPLFIT 

*  evaluates  a  real  non-par ametric  spline 

*  INPUTS 
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array  of  independent  variables 
number  of  values  in  x-array 
spline  segments  generated  by  SPFIT 
x-value  at  which  spline  is  to  be  evaluated 


F(XO)  =  y-value  evaluated  at  xO 
second  derivative  evaluated  at  xO 
index  of  spline  segment  containing  xO 

COMMON  /lO/  SySFIL.PQTFIL.COFFIL.LCOFIL.ICARD.TEXFIL.IPRIN, 
2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAQFIL .RMSFIL , SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL.POTF1L,COFFIL.LCOFIL,ICARD,TEXFIL,IPRIN, 
2  SCRFIL . HPLFIL , LRAFIL , ORGFIL . RAQFIL , RMSFIL .SEVFIL , SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

DIMENSION  X(NPTS) .ELEMS(4.NPTS) 


*  X  = 

*  NPTS  = 

*  ELEMS  = 

*  XO  = 

*  RETURNS 

*  YO  = 

*  SO  = 

*  lELM  = 


N  =  NPTS 

IF  (XO.GE.X(l)  .AND.  XO.LE.X(N))  GO  TO  100 
WRITE  (IPRIN,999)  XO 
GO  TO  99999 
100  CONTINUE 

DO  200  1=2. N 

IF  (XO  .GT.  X(I))  GO  TO  200 
GO  TO  300 
200  CONTINUE 

300  CONTINUE 

I  =  I  --  1 

XX  =  X(I+1)  -  X(I) 

XI  =  XO  -  X(I) 

X2  =  X(I+1)  -  XO 
XX6  =  XX  ♦  XX  /  6.0 
Y1  =  ELEMS(l.I) 

Y2  =  ELEMS (3. I) 

51  =  ELEMS(2.I) 

52  “  ELEHS(4  I) 

YO  =  (SI  •*  X2**3  +  S2  e  Xl**3)  /  (6.0  *  XX)  + 

2  (  (Yl  -  S1*XX6)  *  X2  +  (Y2  -  S2*XX6)  •  XI  )  /  XX 
SO  =  (SI  *  X2  +  S2  ♦  XI)  /  XX 
lELH  =  1 


RETURN 


99999  CONTINUE 


STOP 

999  FORMAT  (’0  SPLVAL  —  EXTRAPOLATION  NOT  ALLOWED.  XO  ='.  E16.8) 


END 


C  DECK  SPPLV2 

SUBROUTINE  SPPLV2  (V.  P,  SEGS.  NSEGS,  PT.  HINT,  TINT.  INT) 


♦  SPPLV2  created  from  LNPLI2  and  LVPLl 

•  finds  intersection  between  a  curve  defined  by  a  parametric  spline 

*  and  a  plane  defined  by  a  point  and  a  direction  vector 


* 

* 

* 

* 

« 


INPUTS 

P(l)  =  X-COORDINATE  OF  POINT  USED  TO  DEFINE  THE  PLANE 

P(2)  =  Y-CQORDINATE  OF  POINT  USED  TO  DEFINE  THE  PLANE 

V(l)  =  X-COMPONENT  OF  VECTOR  PERPENDICULAR  TO  THE  PLANE 

V(2)  =  Y-COMPONENT  OF  VECTOR  PERPENDICULAR  TO  THE  PLANE 

SEGS  =  SPLINE  SEGMENTS  IN  ENDPOINT-TANGENT  FORM.  FROM  SPLNT2 
NSEGS  =  NUMBER  OF  SPLINE  SEGMENTS 


RET’'®*'' 

PT(i)  =  X-COORDINATE  OF  THE  INTERSECTION 
PT(2)  =  Y-COORDINATE  OF  THE  INTERSECTION 
NIHT  =  INDEX  OF  SEGMENT  IN  WHICH  INTERSECTION  LIES 
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i4> 

if. 

if 


TINT  =  VALUE  OF  T  PARAMETER  AT  INTERSECTION 

TNT  =  1  if  intersection  found  and  within  TOLERANCE 

INT  =2’  IF  INTERSECTION  NOT  WITHIN  TOLERANCE 

IKT  =  3,  IF  NO  INTERSECTION  FOUND 

INT  =4.  IF  SEGMENT  LIES  WITHIN  THE  PLANE 

DIMENSION  V(2)  ,P(2) ,SEGS(8,NSEGS) ,PT(2) ,CC(14) ,U(2) 

EQUIVALENCE  ,U( 1 ) )  .  (U2  U(2) ) ,  (CCl , CC( 1 ) ) ■  (CC2 ,CC (2 ) K 

1  (CC3,CC(3)),  (CC4,CC(4)),  (CC5,CC(5)),  (CC6.CC(6)),  (.D.DPS/ 

data  TOLER,  IMAX  /  0.001,  10  / 


INT=1 


*  unitize  planj  Tirection  vector 
CALL  VUNIT2  (U,  S,  V) 

♦  determine  the  segment  number  n  which  contains  the  intersection 


1000 


DO  140  N=1,NSEGS 
DPS-0 .0 


DPE=0.0 
DO  1000  I  = 
DPS  =  DPS  + 
DPE  =  DPE  + 
CONTINUE 


(SEGS(I,N)  -  P(I))*y(I) 
UEGSa+4,N)  -  P(I))*U(1) 


check  il  segment  lies  within  plane,  if  so,  set  int  and  return. 


IF  (  ABS(  DPS  )  .GT.  TOLER  .OR. 

1  ABS(  DPE  )  .GT.  TOLER  )  GO  TO  130 
INT=4 

GU  TO  dd9y9 
130  CONTINUE 

♦  check  if  dot  product  changes  sign  within  segment 


NSEG=N 

IF  (  DPSeDPE  .LT.  0.0  J  GO  TO  200 
IF  C  DPS^DPE  .EQ.  0.0  )  GO  TO  14B 
140  CONTINUE 

NSEG=NSEGS 

N=1 

145  CONTINUE 

♦  check  if  intersection  occurs  at  either  end  of  line 


1150 


1170 


T=0.0 

DO  1170  J  =  1,  5,  4 
DIST  =0.0 


DO  llBO  1=1,2 
K  =  I  +  J  -  1 
PT(I)  =  SEGS(K,N) 

DlST  =  DIST  +  {PT(I)-P(I))  * 


U(I) 


continue 

IF  (  ABS(DIST)  .LE.  TOLER 
N  =  NSEG 
T  =  1.0 
CONTINUE 


GO  TO  1440 


no  intersection  found,  set  int  and  return. 


INT=3 

GO  TO  99999 
200  CONTINUE 


fetch  segment  polynomial  coefficients 
CALL  CUBC02  (SEGS(1,N),  CC) 
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•  determine  scalar  polynomial  coefficients 

A  =  CC1*U1  +  CC2+U2 
B  =  CC3*U1  +  CC4+U2 
C  =  CC5+U1  +  CC6t-U2 
A3=A*3.0 
B2=B*2.0 

•  iterate  for  t  at  which  the  scalar  polynomial  becomes  zero 
ITER=0 

T=DPS/(DPS-DPE) 

300  CONTINUE 

FT=((A*T+B)*T+C)*T+D 

DT=FT/((A3+T+B2)*T+C) 

TsT-DT 

IF  (  ABS(  DT  )  .LE,  0.0000001  )  GO  TO  400 
ITER=ITER+1 

IF  (  ITER  .LE.  IMAX  )  GO  TO  300 

IF  (  ABS(  FT  )  .GT.  TOLER  )  INT  =  2 

400  CONTINUE 

♦  set  intersection  coordinates,  n  and  t  paraimeters 

DO  142.0  1  =  1,2 

COORD  =  ((CC(I)*T  +  CC(I+2))*T  +  CC(I+4))*T  +  CC(I+6) 

IF  <  ABS(  COORD  -  P(I)  )  .LE.  TOLER  )  COORD  =  P(I) 

PT(I)  =  COORD 
1420  CONTINUE 
1440  CONTINUE 
NINT=N 
TINT=T 

99999  CONTINUE 

RETURN 

END 

C  DECK  T2DAMD 

SUBROUTINE  T2DAMD  (K,PHI2D,T2D,T3D) 

*  calculates  added  mass  and  damping  forces  on  a  2-d  section  given 

♦  the  potentials 

COMMON  /CH3D/  ISIGMA,SIGMIN,SIGMAX,V,SINMU,COSMU,WTSI, 

2  IMMIN.IMMAX.IMDEL.LMIN.LMAX 

REAL  SIGHIN,SIGMAX.V.SINHU,C0SMU,WTSI(4) 

INTEGER  ISIGMA , IMMIN , IMMAX , IMDEL.LMIN ,LMAX 

COMMON  /ENVIOR/  VK.NVK, MU, HMU, OMEGA. NOMEGA, SIGMA, NSIGMA.SIGWH, 

1  KSIGWH , TMODAL , NTMOD , NRANG , RANG , RLANG , S , NNMU , FRNUM . VFS 
INTEGER  NVK , NMU . NOME-GA , HSIGMA .NSIGWH . NTMOD . NRANG . NNHU(8) 

REAL  VK(8) ,MU(3T,8) ,0MEGA(30) ,SIGMA(iO) ,SIGWH(4) ,TM0DAL(8) , 

2  RANG(8) ,RLANG(8) ,S(30,8) .FRNUM(8) ,VFS(8) 

COMMON  /GEOM/  X .HSTATN , Y .Z.NOFSET.LPP ,BEAM,DRAFT ,LCF, 

1  VCG , GM , DELGM , NEBLA , KPITCH , KROLL . KY AW , KY AWRL , AWP , VCB , FBDX , FBD Y , 

2  FBDZ , NFRrBD , XPT , YPT , ZPT , NPTS , LCB , GML . AST AT , BSTAT , TITLE , MASS , 

2  DISPLM , IPITCR , IROLL , lYAW , lYAWRL ,CHEAVE ,CPITCH , CHEAPI , CROLL . 

2  AREAMX , WSURF , GI RTH , FBDZV , DBLUL , TLCB 

INTEGER  NSTATN,H0FSET(26) .NFREBD.NPTS 
CRARACTERe4  TITLE(20) 

REAL  X(2E),Y(10,2&),Z(10,25), FBDZV (8,10),LPP.BEAM , DBLWL , TLCB , 

2  DRAFT ,LCF . VCG , GM, DELGM , NEBLA ,KPITCH , KROLL, KY AW .KYAWRL , AWP , VCB , 

2  FBDX(10),FBDY(10),FBDZ(10) ,XPT(10) ,YPT(10) ,ZPT(lO) ,LCB,GML, 

4  ASTAT(2B5 ,BSTAT(2B) , MASS, DISPLM, IPITCH, IROLL, lYAW, 

B  1 Y AWRL , CHEAVE , CPITCH , CHEAP I , CROLL , AREAMX . WSURF . GIRTH ( 2B ) 

COMMON  /PHYSCO/  II ,TPI , PI ,PIOT, DEGRAD, RADDEG ,VKHETR,METRVK ,GRAV , 
2  RHO , GNU , RHOS , RHOF , GNUS , GNUF . FTMETR , PUN ITS , REYSCL 

T  T 

Vurti  ULtA 

CHARACTER*4  PUNITS(2) 

REAL  TPI , PI , PIOT , DEGRAD , RADDEG , VKMETR , METRVK , GRAY , RHO . GNU , RHOS , 


1  RBOF,GNUS,GNUF.FTMETR 


COMMON  /WGHTS/  WTDL.NORM 
REAL  WTDL(10,2B),N0RM(4,10,26) 

COMPLEX  PHI2D(10,10,4) , CTEMP ,T2D(10 , 10) ,T3D(10,10) 

DIMENSION  IDX(IO) , JDX(IO) 

DIMENSION  T(25) .ElEMS(4,2B) 

DATA  IDX/1,3,B,3,2.4,6,2.2.4/ 

DATA  JDX/1.3.6.5.2,4.6,4,6.6/ 

NNODES=HOFSET(K) 

IF(NNODES.LE.O)  RETURN 
DO  3  I=1.NSTATN 
T(I)=0.0 
3  CONTINUE 
T(K)=1.0 

CALL  SPFIT  (X.T.ELEMS.KSTATN) 

CALL  SPINTG  (X( 1) . X(NSTATN ) .X .NSTATN ,ELEMS . 0 . 0 ,WTL1 .DUM) 

DO  10  ISIGMA=1 .NSIGMA 
DO  1  L=LM1N,LMaX 
CTEMP  =  (0, .0. ) 

I=1DX(L) 

IN  =  I 

IF  (I  .EQ.  B)  IN  =  3 
IF  (1  .EQ.  6)  IN  =  2 
J=JDX(L) 

JP=J 

IF  (J  .EQ.  5)  JP=3 

IF  (J  .EQ.  6)  JP=2 

XFCTR=1.0 

IF  a  .EQ.  6)  XFCTR=-XFCTR*X(K) 

IF  (I  .EQ.  6)  XFCTR=  XFCTR*X(K) 

IF  (.■'  .EQ,  XFCTR=-XFCTR*X(K) 

IF  (J  .EQ.  6)  XFCTR=  XFCTR*X(K) 

DO  2  M=1,NN0DES 

CTEMP  =  CTEMP  +  WTDL(M,K)+N0RM(IN,H,K)*PHI2D(ISIGMA,M,JP) 

2  CONTINUE 

T2D(ISIGMA,L)  =  2.0*II*RHO*SIGMA(ISIGMA)*XFCTR*CTEMP 
T3D(ISIGMA,L)  =  T3D(ISiaMA,L)  +  WTLI'*T2D(ISIGMA ,L) 

1  CONTINUE 

10  continue 

RETURN 

END 

C  DECK  T3DAMD 

SUBROUTINE  T3DAHD 

COMMON  ./CH3n/  ISIGMA,SIGMIN.SIGMAX,V,SINMU,COSMU,WTSI, 

2  IHMIN.IMMAX.IMDEL.LMIN.LMAX 

REAL  SIGHIN , SIGMAX , V .SINMU , COSMU .WTSI (4) 

INTEGER  ISIGMA , IMMIN , IMMAX , IMDEL.LMIN ,LHAX 

COMMON  /DATINP/  OPTN,MOTN,BSCFIL.VLACPR.RAOPR,RLDMPR,DISPLMT, 

2  LRAOPR . ADRPR , ORGOPTN , OMNOM , KG , STATN ( 26 ) , NSOFST ( 2B ) . 

2  NLEVF(2B),HLFBTH(10,26) ,WTRL«E(10,2B) ,BLEWF(2B) ,TLEWF(2B) , 

2  AREALF(2B),NPTL0C,PTNUMB(10) .PTNAME,XPTL0C(10) ,YPTL0C(10) , 

2  ZPTLOCI 10 ) , NBB ,FBNUMB( 10 ) , FBN AME , XPTFBD (10), YPTFBD ( 10 ) , 

2  2PTFED(10) ,FBC0DE(10) ,FBTYPE,RD0T(10) .VKDES.FNDES, 

2  STATNM.STATIS 

CHARACTF.R‘'4  PTBAME(8 , 10)  ,FBNAME(8 . 10)  ,STATNM(B)  .FBTYPEO  .  10) 
INTEGER  OPTN , MOTN , BSCFIL . VLACPR , RAOPR . ADRPR , RLDMPR , FBCODE , 

2  FBNUMB.PTNUMB, ORGOPTN 
REAL  KG 

COMMON  /EKVIOR/  VK.NVK, MU, NMU, OMEGA, NOMEGA, SIGMA, NSIGMA, SIGWH, 

1  NSIGWH , TMODAL , ITHOD , NRANG , RANG , RLANG , S , NNMU , FRNUM . VFS 
INTEGER  SVK , KKU , KQMEG*. , SSIC-MA , KSTfiWH . NTMDD . NRANG . NNMU (8 ) 

REAL  VK(8) .MU(37,8) ,0MEGA(30) ,SIGKA(iO) ,SIGWH(4) ,TM0DAL(8) , 

2  RANa(8) ,RLANG(8) ,S(30,8) ,FRNUM(8) ,VFS(8) 
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COMMON  /GEOM/  X .NSTATK . Y ,7 , NOFSET ,LPP .BEAM , DRAFT . LCF . 

1  VCG , GM , DELGM , NEBLA .KPITCH , KROLL ,KY AW , KYAWRL , AWP . VCB . FBDX , FBDY . 

2  FBDZ , NFREBD , XPT , YPT , ZPT , NETS .LCB . GML . ASTAT , BSTAT . TITLE , M ASS , 

2  DISPLM , IPITCH , IROLL . lYAW . lYAWRL .CHEAVE . CPITCH . CHEAPI , CROLL , 

2  A  RE  A  i:X  .  W3URF ,  G I RTH  .  FBDZ  V ,  DBLWL ,  TLCB 

INTEGER  NSTATN,N0FSET(28) , NFREBD, NPTS 
CHAFiACn::R»4  TITLE(20) 

REAL  J:i::.6),Y(10.2S)  ,Z(10.25)  .FBDZV(8. 10). LPP. beam, DBLWL. TLCP, 

2  DRAFT.'  CF. VCG. GM, DELGM. NEBLA. KPITCH. KROLL, KY AW. KYAWRL. AWP. VCB. 
2  FBDX(IO) ,FBDY(10) ,FBDZ( 10) . XPT( 10) ,YPT(10) .2PT(]0) .LCB.GHL. 

4  ASTAT(26) .BSTAT(25) .MASS .DISPLM . IPITCH . IROLL ,IY AW , 

6  lYAWRL, CHEAVE, CPITCH. CHEAPI, CROLL, AREAHX.WSURF,C1RTH(25) 

COMMON  /INDEX/  PFIDX .LPFIDX , RMIDX .LRHIDX.SVIDX .LSVIDX 

INTEGER  LPFIDX, LRMIDX, LSVIDX 

REAL  PFIDX(235) .RMIDX(183) ,SVIDX(3) 

COMMON  /lO/  SYSFIL.PQTFIL.COFFTL.LCOFIL.ICARD.TEXFIL.IPRIN, 

2  SCRFIL.HPLFIL.LRAFIL.ORGFIL.RAOFIL.RMSFIL.SEVFIL.SPDFIL. 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL.POTFIL.COFFIL.LCOFIL.ICARD.TEXFIL.IPRIN, 

2  SCRFIL.HPLFIL.LRAFIL.QRGFIL.RAOFIL.RMSFIL.SEVFIL.SPDFIL, 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /PELEH/  PELEM 
COMPLEX  PELEM (4, 1000) 

COMMON  /STATE/  LAT . VRT , LOADS . ADORES .SALT, HEAD . EXROLL , BKEEL 
LOGICAL  L AT , VRT . LOADS , ADDRES , S ALT , HEAD , EXRQLL , BKEEL 

COMMON  /STELEM/  STELEM 
COMPLEX  STELEM (4, 9,2.60) 

COMMON  /TELEM/  TELEM 
COMPLEX  TELEM(4,9.10) 

COMMON  /WGHTS/  WTDL.NORH 
REAL  UTDL(10.26).N0RM(4.10.26) 

COMPLEX  T3D(10,10)  ,PHI2D(10.10.4) 

equivalence  TPELEMU.l)  .TSDU  ,1)  )  ,  (PELEM(l  ,26)  ,PHI2D(  1 , 1 , 1 ) ) 
COMPLEX  T2D(10,10) 

READ  (SCRFIL)  WTDL.NQRM 
BACKSPACE  SCRFIL 
IMKIK  =  1 

IF  (.NOT.  VRT)  IMHIN  =  2 
IMMAX  =  4 

IF  (.NOT.  LAT)  IMMAX  =  3 
IMDEL  =2 

IF  (VRT  .AND.  LAT)  IMUKL  =  1 
LMIN  =  1 

IF  (.NOT.  VRT)  LMIN  =  6 
LMAX  =  10 

IF  (.NOT.  LAT)  LMAX  =  4 
DO  20  1=1,10 
DO  10  J=l,iO 
T3D(I,J)  =  (0.0, 0.0) 

10  CONTINUE 
20  CONTINUE 

DO  30  K=1.HSTATN 
SPT  =  NOFSET(K) 

IF  (NPT  .LT.  2)  GO  TO  30 
CALL  RPHI2D  (K,PHI2D) 

CALL  T2DAMD  (K,PHI2D,T2D,T3D) 

M  =  (K-l)*10 
DO  26  L=LMIH.LHAX 
M  =  K  +  1 

rill.  rPFTT  (SIGMA. T2D(1. L) .STELEM(1.1.M),NSIGMAJ 
26  CONTINUE 
30  CONTINUE, 
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DO  40  L-LMIN,LMAX 

CALL  CPFIT  (SIGMA, T3D(1,L).TELEM(1,1.L),NS1GMA) 

40  CONTINUE 

REWIND  COFFIL 
WRITE  (COFFIL)  TELEM 
REWIND  COFFIL 

IF  (RLDMPR  .GT,  0)  CALL  AMDPRN  (SIGMA .NSIGMA) 

RETURN 

END 

C  DECK  TANAKA 

SUBROUTINE  TANAKA 

*  calculates  coefficient  C  (=:EDDY(K))  and  RADIUS  (=RGB(K)) 

•  for  calculating  eddy-makinj;  roll  damping  by  the  method  of 

♦  TANAKA,  J.SOSEN  KT.OKAI,  V.  109,  1961 

COMMON  /ENVIOR/  VK .NVK , MU ,NMU , OMEGA .NOMEGA .SIGMA .NSIGMA ,SIGUH  , 

1  NSIGWH.TMODAL.NTMOD.NRAKG.RANG.RLANG.S.NNHU.FRNUM.VFS 
INTEGER  NVK, NMU, NOMEGA, NSIGMA, NSICWH.NTHDD.NRANG.NNMU (8) 

REAL  VK(8) .MU(37,8) .OMEGAOO) ,SIGMA( 10) ,SIGWH(4) ,TH0DAL(8)  , 

2  RANG(8) ,RLANG(8) ,S ( 30 , 8 ) ,FRNUM(8) . VFS(8) 

COMMON  /GEOM/  X , NSTATN .Y .2 . NOFSET .LPP , BEAM .DRAFT , LCF , 

1  VCG,GM,DELGM,NEBLA,KPITCH,KROLL,KYAW.KYAWRL, AWP.VCB.FBDX.FBDY, 

2  FBDZ.NFREBD,XPT,YPT.ZPT,NPTS.LCB.GKL,ASTAT,BSTAT. TITLE, MASS, 

2  DISPLM , IPITCH , IRQLL , lYAW , I YAWRL , CHEAVE , CPITCH , CHEAPI , CROLL , 

2  AREAMX.WSURF, GIRTH, FBDZV.DBLWL.TLCB 

INTEGER  NSTATN. N0FSET(25) .NFREBD.NPTS 
CHARACTER*4  TITLE(20) 

REAL  X(25) ,Y(10,25) ,2(10.25) ,FBDZV(8,10) , LPP, BEAM, DBLWL.TLCB, 

2  DRAFT . LCF , VCG , GM , DELGM , NEBLA .KPITCH , KROLL.KYAW , KY AWRL , AWP , VCB , 

2  FBDX(10),FBDY(10) .FBDZClO) ,XPT(10) ,YPT(10) ,2PT(10) ,LCB,GML. 

4  ASTAT(25) ,B3TAT(25) .MASS, DISPLM, IPITCH, IROLL.IYAW, 

5  I YAWRL , CHEAVE , CPITCH , CHEAP I , CRQLL , AREAHX , WSURF , GIRTH ( 25 ) 

COMMON  /RLDBK/  PSUR':25) ,BMK(26) ,DK(26) ,CAK(25) ,HQ ,HSPAN .HMNCHD , 

2  HAREA,HXCP,HyCP,H2CP,HGAMHA,HYHAT,HEAR,HLCS,RQ(2) ,RSPAN(2) , 

2  RMNCHD(2) ,RAREA(2) .RXCP(2) ,RYCP(2) ,RZCP(2) .RGAMMA(2) , RYHAT(2) , 

2  REAR(2) ,RLCS(2) ,sq(2) ,SSPAN<2) .SMNCHD(2) ,SAREA(2) ,SXCP(2) , 

2  SYCP(2),S2CP(2).SGAMMA(2),SYHAT(2),SEAR(2),SLCS(2),BC)(2) , 

2  BSPAH(2) ,BMNCHD(2) ,BAREA(2) ,BXCP(2) ,BYCP(2) ,BZCP(2) ,BGAMMA(2)  , 

2  BYHAT(2) ,BEAR(2) .BLCS(2) ,Fq(2) ,FSPAN(2) ,FMNCHD(2) ,FAREA(2) , 

2  FXCP(2) ,FYCP(2) ,FZCP(2) .FGAMHA(2) ,FYHAT(2) ,FEAR(2) ,FLCS(2) , 

2  Pq(2,2) ,PSPAN(2,2) ,PMNCHD(2,2) ,PAREA(2.2),PXCP(2,2) ,PYCP(2,2) , 

2  PZCP(2,2),PGAMMA(2,2) ,PYHAT(2,2) ,PEAR(2,2) ,PLCS(2,2) , 

2  STADMP(IO) ,SBPDMP(10,8) , EKCON ,WPHI ,TPHI ,WMELM(4 ,9) ,SFELM(4 ,9 , 8) , 

2  KEELM(4,9,8) ,PEELM(4 .9 , 8) ,FEELM(4 .9,8 ) ,HEELM(4 , 9 . 8) , BEELM(4 , 9 , 8 ) , 
2  ENWM,EKSF(8,8) ,ENRE(8) ,ENPE(8) ,ENFE(8) ,ENHE(8) ,ENBE(8) . 

2  ENEMV(8,8) ,ENRL(8) ,ENPL(8) ,EHFL(8) ,ENHL(8) ,ENSL(8) ,ENBL(8) , 

2  E«3KF(8,S),RELK(4,9) ,ITS(2E) .RD(25).EDDY(8,2B) ,RGB(26) 

REAL  RDBLK(2692) 

EquiVALENCE  (PSUR(1),RDBLK(1)) 

DO  20  IA=1,KRAHG 
DO  10  K=l, NSTATN 
fiDDY{IA,K)  =  0 
RGB(K)  =  0. 

IF  (NOFSET(K)  .LT.  2)  GO  TO  10 
BLOCAL  ^  BMK(K) 

TLOCAL  =  DK(K) 

ORG  =  TLOCAl  -  VCG 

IF  (ITS(K)  .Eq.  1)  CALL  SERD  (K, RANG (1A),BL0CAL, TLOCAL, ORG, 

2  EDDY(IA,K),RGB(K)) 

IF  (ITS(K)  .Eq.  2)  CALL  SERAB  (K,RANG(IA) .BLOCAL, TLOCAL, ORG, 

2  RD(K).EDDY(IA,K),RGB(K)) 

IF  (ITS(K)  .NE.  3)  GO  TO  10 

*  stations  vith  skegs 

ORG  =  TLOCAL  -  VCG 
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CALL  SERE  (BLQCAL , ORG , EDDY (lA .K) .RGB (K) ) 
10  CONTINUE 
20  CONTINUE 


RETURN 

END 


C  DECK  TEPEAK 

SUBROUTINE  TEPEAK 


(NWEVN ,WEVN ,ERS .XTOE.TPI) 


this  routine  obtains  the  period  of  max  energy  of  an  encounter 
spectrum. 

W.G. MEYERS,  DTNSRDC,  072877 


10 


DIMENSION  WEVN(NWEVK 
PEAK  =  0. 

XTOE  =  TPI/WEVNd) 

DO  10  1=1. NWEVN 
TE  =  TPI/WEVN(I) 

IF  dRSd) 'GT.PEAK) 
IF  (ERSCI) .GT.PEAK) 
CONTINUE 


NWEVN) 


XTOE  =  TE 
PEAK  =  ERS(I) 


RETURN 

END 


C  DEiCK  TFNFiT 

SUBROUTINE  TFNFIT  (RLANG .NRAKG.RLANS ,MOTL , JM .IW , CTFN) 
DIMENSION  RLANG(8) 

COMPLEX  M0TL(3,30.8) ,CANS(8) ,CELM(4,8) .CTFN.CDUM 

IF  (RLANS  .GE.  RLANG(l))  GO  TO  10 
CTFN  =  K0TL(JM,IW,1) 

GO  TO  40 

10  IF  (RLANS  -LE.  RLANGCNRANG) )  GO  TO  20 
CTFN  =  MOTL(JM,IW,NRAHG) 

GO  TO  40 

20  DO  30  IA=1,NRANG 

CANS(IA)  =  HOTLCJM.IW.IA) 

30  CONTINUE 

CALL  CPFIT  (RLANG, CANS, CELM.NRANG) 

CALL  CPLVAL  (RLANG, NRANG.CELM. RLANS, CTFN, CDUM.IELM) 
40  CONTINUE 


RETURN 

END 


C  DECK  ^Q£  (kreC,A0MGE,RAO1,RAO2,JA,IT,R,B2,HPREDH,NLCH,N1, 

2  N2 , HBETA , DELBET , NWEVN , WEVN , IV ,DATA ) 

DIMENSION  KREC(13) . AOMGE(30 , 13) .RA01(30 ,8 , 13) ,RA02(30 ,8 , i 1) , 

2  R(30) ,B2(36) ,WEVN(lOO) , DATA (4325 .DUM1(30) ,DUM2(30) , ARLCl ( 100) , 

2  ARLC2(100) ,ARLC3(100),RLC(100,24) 

COMMON  /ENVIOR/  VK , NVK , HU ,NMU , OMEGA ,NOMEGA . SIGMA .HSIGMA , SIGWH , 

1  NSIGWH  TMODAL,NTMQD,NRANG, RANG, RLANG, S,NNMU,FRNUM,VFS 

INTEGER  NVK  NMU , NOMEGA , HSIGMA , NSIGWH , NTMOD , HRANG ,NNMU (8) 

REAL  VK(8) ,MU(37,8) ,0MEGA(30) ,SIGMA(10) .SIGWH(4) ,TM0DAL(8) , 

2  RANG(8) ,RLANG(8) ,S(30,6) ,FRNUM(8) ,VFS(85 

COMMON  /PHYSCO/  II ,TPI , PI ,PI0T, DEGRAD, RADDEG ,VKHETR,HETRVK,GRAV , 
2  RHoVgNU , RHOS . RHOF, GNUS ', GHUF .FTMETR ,PUNITS , REYSCL 
COMPLEX  II 

REAL^TPd PI , PiSt!dEG WD . RADDEG ,VKMETR, METRVK ,GRAV ,RHO . GNU , RHOS , 

1  RHOF, GNUS, GNUF, FTMETR 

INTEGER  DELBET 


DO  60  IH=1,NHU 
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HDNG  =  (IH-l)fDELBET 

11  =  HI  +  IH 

12  =  N2  -  IH 

IF  (12  .LE.  0)  12  =  12  +  NBETA 
IF  (KREC(IH)  .GT.  0)  GO  TO  20 
DO  10  I=1,NWEVN 
10  RLCd.Il)  =  0. 

GO  TO  50 

20  CALL  PSPLC  (NOMEGA , OMEGA ,AOMGE( 1 .IH) ,VK(IV) , HDNG , DEGRAD , GRAV , 

2  VKMETR,DUM1,DUM2,RA01(1.JA,IH) ,S(1.IT) .R.NWEVN ,WEVN , ARLCl , ARLC2 , 
2  ARLC3,RLC(1,I1)) 

IF  (KREC(IH)  .EQ.  2)  GO  TO  40 
DO  30  I=1,NWEVN 
30  RLC(I,I2)  =  RLC(I,I1) 

GO  TO  50 
40  KH  =  IH  -  1 

CALL  PSPLC  (NOMEGA, OMEGA, AOHGEd, IH) ,VK(IV) , HDNG, DEGRAD, GRAV, 

2  VKMETR,DUM1,PUM2,RA02(1.JA,KH) ,S(l . IT) , R, NWEVN ,UEVN , ARLCl , ARLC2 , 
2  ARLC3,RLC(1,I2)) 

80  CONTINUE 

L  =  0 

DO  60  IPH=1,NPREDH 

CALL  PSPSC  (NWEVN , UEVN , RLC , NBETA , B2 , NLCH . IPH , ARLC 1 . ARLC2 . TOELC , 

2  TOESC,TPI) 

L  =  L  +  1 
DATA(L)  =  TOELC 
L  =  L  +  1 
DATA(L)  =  TOESC 
60  CONTINUE 

RETURN 

END 

C  DECK  TRIM 

SUBROUTINE  TRIM 

*  This  subroutine  provides  the  correction  ol  zero-speed  freeboard 

*  lor  the  sinkage  and  trim  induced  by  forward  speeds.  Reference- 

*  RICHARD  C.  BISHOP  and  NATHAN  K.  BALES,  "A  SYNTHESIS  OF  BOW 

*  WAVE  PROFILE  AND  CHANGE  OF  LEVEL  DATA  FOR  DESTROYER-TYPE  HULLS 

*  WITH  APPLICATION  TO  COMPUTING  MINIMUM  REQUIRED  FREEBOARDS," 

*  DTNSRDC  REPORT  78-SPD-811-01 ,  JAN.  1978.  The  formulae  for 

*  sinkage,  20,  were  developed  in  units  ol  feet.  Conversion 

*  to  meters  is  provided.  The  formulae  for  trim,  ang,  were 

*  developed  in  units  of  degrees.  Conversion  to  radians  is  made. 

*  ship  speed  is  in  knots.  NBB=0  means  a  ship  without  a  bon  dome. 

COMMON  /DATINP/  OPTN,MOTH ,BSCFIL,VUCPR,RAOPR,RLDMPR,DISPLMT , 

2  LRAOPR , ADRPR , ORGOPTN , GMNOM , KG , STATN (26 ) , NSOFST ( 26 ) , 

2  NLEWF(26)  .HLFBTHdO  ,26)  ,WTRLNEdO,25)  ,BLEWF(26)  ,TLEWF(25)  , 

2  AREALF ( 26 ) , NPTLOC , PTNUMB (10 ) , PTN AME , XPTLOC (10), YPTLOC (10), 

2  ZPTLOC ( 10 ) . NBB , FBNUMB (10 ) ,FBK AME , XPTFBD (10 ) , YPTFBD ( 10 ) , 

2  ZPTFBD(IO)  ,FBCODEdO)  ,FBTYPE,RD0Td0)  ,VKDES,FNDES, 

2  STATNM,STATIS 

CHARACTERf4  PTHAME(8 , 10) ,FBNAME(8, 10) ,STATNM(B) ,FBTYPE(3 , 10) 
INTEGER  OPTN ,MOTN , BSCFIL ,VLACPR,RAOPR, ADRPR, RLDMPR, FBCODE , 

2  FBNUMB, PTNUMB, ORGOPTN 
REAL  KG 

COMMON  /ENVIOR/  VK,NVK, MU, NMU, OMEGA, NOMEGA, SIGMA, NSIGMA.SIGWH, 

1  NSIGWH ,TMODAL ,NTMOD ,NRANG ,RANG ,RLANG ,S ,NNMU , FRNUM ,VFS 
INTEGER  NVK , NMU , NOMEGA . NSIGMA , NSIGWH . NTNOD .NRANG , NNMU(8 ) 

REAL  VK(8) ,MU(37,8) ,0MEGA(30) ,SIGKAdO) ,SIGWH(4) ,TM0DAL(8) , 

2  RAHG(8) ,RLANG(8) ,S(30,8) ,FRNUM(8) .VFS(8) 

COMMON  /GEOM/  X,NSTATN,Y,Z,NOFSET,LPP, BEAM, DRAFT, LCF, 

1  VCG , GM , DELGM , NEBLA , KPITCH , KROLL ,KYAW ,KY AWRL , AWP , VCB , FBDX , FBDY , 

2  FBD2 , NFREBD , XPT , YPT , ZPT , NPTS , LCB , GML , ASTAT , BSTAT , TITLE , MASS , 

2  DISPLM , IPITCH , IROLL , lYAW , lYAWRI., CHEAVE, CPITCH , CHEAPI , CROLL , 

2  ARE AMX .WSURF. GIRTH , FBDZV,DBLWL,TLCB 

INTEGER  NSTATN.N0FSET(26) .HFREBU.NPtS 
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REAL  X(25) ,Y(10,2B) ,Z(lO,26) .FBDZV(8 , 10) , LPP .BEAM ,DBLWL ,TLCB , 

2  DRAFT, LCF,VCG,GM,DELGM,NEBLA,KPITCH,KROLL,KYAW,KYAWRL,AWP,VCB, 

2  FBDX(10),FBDY(10) ,FBDZ(10) ,XPT(10) ,YHT(10) ,2PT( 10 ) , LCB , GML , 

4  ASTAT(2S) ,BSTAT(25) .T1TLE(20) .MASS,DISPLM,IPITCH,IROLL,IYAW, 

6  lYAWRL , CHEAVE , CPITCH , CHEAPl , CRQLL , AREAMX . WSURF , GI RTH (25 ) 

COMMON  /PKYSCO/  II ,TPI , PI , PIOT . DEGRAD , RADDEG , VKMETR . METRVK .GRAY , 
2  RHO , GNU , RHOS , RHOF . GNUS , GHUF , FTMETR .PUNITS . REYSCL 

COMPLEX  II 

CHARACTER*4  PUNITS(2) 

REAL  TPI , PI , PIOT .DEGRAD , RADDEG . VKMETR .METRVK , GRAV ,RHO , GNU , RHOS , 

1  RHOF, GNUS, GNUF, FTMETR 

REAL  LO 

CHARACTER*4  METER 

DATA  METER  /’METE’/ 

CON  =  1 

IF  (PUNITS (1)  .EQ.  METER)  CON  =  FTMETR 

DO  1  1=1, NVK 


*  speed  is  FRQUDE  scaled  to  LO  ship 

LO  =  480.*C0N 

VO  =  SQRT(LO/LPP)  *  VK(I) 

V2  =  VOfVO 
V3  =  V2*V0 

IF  (NBB  .EQ.  0)  GO  TO  20 

*  ship  with  bow  dome 

ZO  =  (,007848*VO  +  . 001321 •VZ)  *  CON 

ANGO  =  (.01S422*VO  -  .0021752*V2  +  5.957E-5*V3)  •  DEGRAD 
GO  TO  30 
20  CONTINUE 

*  ship  without  bow  dome 

ZO  =  (-,005292*V0  +  .001855*V2)  ♦  CON 

ANGO  =  (.O092648*V0  -  .0016692*V2  +  4 .2912E-5+V3)  *  DEGRAD 
30  CONTINUE 

*  sinhage  FROUDE  scaled  Irom  LO  ship  to  LPP  ship. 

*  sinXage  and  trim  both  defined  positive. 

*  freeboard  correction  =  F  -  SINKAGE  +  FBDX*TRIM 

DO  6  J=1,NFREBD 
SNK  =  ZO  *  LPP/LO 
TRM  =  ANGO 

FBDZV(I.J)  =  FBDZ(J)  -  SNK  +  FBDX(J)*TRM 
5  CONTINUE 

1  CONTINUE 

RETURN 

END 


C  DECK  TRNLAT 

SUBROUTINE  TRNLAT  (VCG.TL.EXCL.TLG.EXCLG) 
COMPLEX  TL(3,3) ,EXCL(3) .TLG(3 ,3) ,EXCLG(3) 


TLGfl.l)  =  TL(1,1) 

TLG(1,2!)  =  TL(1,2)  +  VCGfTLd.l) 

TLG(1,3)  =  TL(1,3) 

TLG(2,1)  =  TLG(1,2) 

TLG(2,2)  =  TL(2,2)  +  VCG*(TL(1,2)  +  TL(2,1)  +  VCG*TL(l,l)) 
TLG^2,3J  =  TL^2,3^  +  VCG*TL(1,3) 

TLGv.3,1/  -  TLvS.l/ 

TLG(3,2)  =  TL(3,2)  +  VCG*TL(3,1) 

TLG(3,3)  =  TL(3,3) 
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EXCLG(l)  =  EXCLClJ 

EXCLG(2)  =  EXCL(2)  +  VCG*EXCL(l) 

EXCLG(3)  =  EXCH3) 

RETURN 

END 

C  DECK  TWDDPT 

SUBROUTINE  TWODPT  (KSTA , YSTA ,2STA , NPT . PHI2D) 

*  This  subroutine  provides  tuo-dimensional  velocity  potentials  for 

*  oscillating  cylinders  of  arbitrary  cross  section  in  a  free  surface 

*  lour  velocity  potentials  associated  with  the  individual  modes 

*  of  oscillation,  surge,  sway,  heave,  and  roll,  are  obtained  which 

*  are  stored  in  PHI2D  (frequency,  offset  point,  mode). 

COMMON  /ENVIOR/  VK , NVK , MU ,KMU .OMEGA .NOMEGA , SIGMA .NSIGMA , SIGWH , 

1  NSIGWH,TMODAL,NTMOD,NRANG,RANG.RLANG,S,NNMU,FRNUM.VFS 
INTEGER  NVK , NMU , NOMEGA , NSIGMA ,NSIGWH . NTMOD , NRANG , NNMU(8 ) 

REAL  VK(8),MU(37,8) ,0MEGA(3O) ,SIGMA( 10) ,SIGWH(4) ,TMQDAL(8) , 

2  RANG(8) ,RLANG(8) ,S(30,8) ,FRNUM(8) ,VFS(8) 

COMMON  /GEQM/  X , NSTATN , Y ,2 ,NOFSET ,LPP , BEAM ,DRAFT ,LCF , 

1  VCG , GM , DELGM , NEBL A , KPITCH , KROLL , KYAW ,KY AWRL . AWP , VCB , FBDX , FBDY , 

2  FBDZ , NFREBD , XPT . YPT , ZPT , NPTS ,LCB , GML , ASTAT , BSTAT . TITLE . M ASS , 

2  DISPLM , IPITCH , IROLL , lYAW , lYAWRL , CHEAVE , CPITCH , CHEAPI , CRQLL , 

2  AREAMX , WSURF .GIRTH , FBDZV .DBLWL . TLCB 

INTEGER  NSTATN , NOFSET( 2E ) , NFREBD , NPTS 
CHARACTER+4  TITLE(20) 

REAL  X(25) .Y(10,25) .2(10,26) ,FBDZV(8,10) ,LPP , BEAM .DBLWL .TLCB . 

2  DRAFT, LCF, VCG, GM, DELGM, NEBLA, KPITCH, KROLL, KY AW, KY AWRL, AWP, VCB. 

2  FBDX(10),FBDY(10) ,FBD2(10) ,XPT(10) ,YPT(10) , ZPT( 10) , LCB , GML . 

4  ASTAT(25) ,BSTAT(25) .MASS , DISPLM , IPITCH , IROLL , lYAW , 

6  I YAWRL , CHEAVE , CPITCH .CHEAPI , CRQLL , AREAMX , WSURF , GIRTH ( 26 ) 

COMMON  /lO/  SYSFIL.PQTFIL.COFFIL.LCOFIL.ICARD.TEXKIL.IPRIN, 

2  SCRFIL . HPLFIL .LRAFIL .ORGFIL .RAOFIL.RMSFIL, SEVFIL, SPDFIL , 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL , POTFIL . COFFIL . LCOFIL , ICARD , TEXFIL , IPRIN , 

2  SCRFIL , HPLFIL , LRAFIL , ORGFIL , RAOFIL.RMSFIL , SEVFIL , SPDFIL . 

2  SPTFIL,LACFIL,LAEFIL 

COMMON  /PHYSCO/  II ,TPI , PI ,PIOT .DEGRAD .RADDEG ,VKMETR,METRVK ,GRAV , 

2  RHO , GNU , RHOS , RHOF , GNUS , GNUF ,FTMETR,PUN1TS , REYSCL 
COMPLEX  II 

CHARACTER+4  PUNITS(2) 

REAL  TP I , P I , PIOT . DEGRAD . RADDEG , VKMETR , METRVK , GRAV , RHO , GNU , RHOS . 

1  RHOF, CRUS, GNUF, FTMETR 

COMMON  /STATE/  LAT.VRT, LOADS, ADORES, SALT. HEAD, EXROLL, BKEEL 
LOGICAL  LAT , VRT , LOADS , ADORES , SALT . HEAD , EXROLL , BKEEL 

COMMON  /TWOD/  YY,  ZZ,  ENN,  ISTA 
INTEGER  ISTA 

REAL  Yy(l0,25) , ZZ(10, 26) .ENN(4, 10,26) 

COMPLEX  RHSKlO),  RHS2(10).  RHS3(10).  RHS4(10),  Ql(lO),  02(10), 
03(10),  04(10),  GREENVdO.lOh  GREENL(  10 , 10)  ,  CTVdO.lO), 
CTL(IO.IO).  UV(10,10).  UL(IO.IO),  SIGIM,  FAC, 
PHI2D(10,10,4) 

DIMENSION  POTLOG(2,10,10),  PTNL0G(2.10,10) ,  CN(IO).  SN(IO) 
DIMENSION  YS(ll),  2S(11),  IPV(IO),  IPL(IO) 

DIMENSION  YSTA(IO) .ZSTA(IO) 

DIMENSION  SP(IO) .SO(IO) ,W1(10),W2(10) 

LOGICAL  LID 

ISTA  =  KSTA 

FACTOR  =  SORT(GRAV*LPP) 

SORLG  =  SORT(LPP/GRAV) 

UU  OU  f  n«Ja.\jrin 

SIGMA(I)  =  SIGMA(l)*SriRLG 
60  CONTINUE 
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DD  70  J-1,NPT 

ENN(4, J.ISTA)  =  EHN(4, J ,ISTA)/LPP 
YS(J)  =  YSTA(j)/LPP 
ZS(J)  =  ZSTA(J)/LPP 
YY(J,ISTA)  =  YY(J.ISTA)/LPP 
ZZ(J,ISTA)  =  ZZ(J.ISTA)/LPP 
70  CONTINUE 
SQ(1)  =  0. 

DO  72  N=2,NPT 
MM  =  N  -  1 

YINT  =  YS(N)  -  YS(NH) 

ZINT  =  ZS(N)  -  Zs(NM) 

GIR  =  SQRT(YINT*YINT+ZINT*2INT) 
sq(N)  =  SQ(NH)  +  GIR 
72  CONTINUE 

NON  =  NPT  -  1 

YINT  =  YYCl.ISTA)  -  YS(1) 

ZINT  =  ZZCl.ISTA)  -  ZS(1) 

GIR  =  SQRT(YINT*YINT+Z1NT*ZINT) 

SP(1)  =  GIR 
DO  74  N=2,NQN 
HM  =  N  -  1 

YINT  =  YYCN.ISTA)  -  YY(NM.ISTA) 

ZINT  =  2Z(N.ISTA)  -  ZZ(NM.ISTA) 

GIR  =  SqRT(YINT*YINT+ZINT*ZINT) 

SP(N)  =  SP(NM)  +  GIR 
74  CONTINUE 

DO  76  N=2,N0N 
NM  =  N  -  1 

DEN  =  SP(N)  -  SP(NM) 

W1(N)  =  (SP(N)  -  SQ(N))/DEN 

W2(N)  =  (SQ(N)  -  SP(NM))/DEN 

76  CONTINUE 

DEN  =  SP('2)  -  SP(1) 

Wl(l)  =  (SP(2)  -  SQ(1))/DEN 

W2(l)  =  (Sq(l)  -  SP(1))/DEN 

NM  =  NON  -  1 
DEN  =  SP(NON)  -  SP(NM) 

Wl(NPT)  =  (SP(NON)  -  SQ(NPT))/DEN 

W2(NPT)  =  (SQ(NPT)  -  SP(NM))/DEN 

♦  test  lor  LID 
LID  =  .TRUE. 

IF  (ABS(YS(NPT))  .LE.  l.OE-5)  LID  =  .FALSE. 

NARG  =  NPT 

IF(.NOT.LID)  NARG  =  NPT-1 
NZRO  =  NPT  +  1 

beloB  tvo  cards  are  to  introduce  one  more  segment  on  the  Iree 
Eurlace  inside  a  cross  section  lor  removing  irregular  Irequencies. 

YS(KZRO)  =  0. 

ZS(HZRO)  =  0. 

CALL  GRNLOG(  YS,  ZS.  NARG,  POTLOG,  PTNLOG,  CN.  SN) 

DO  10  K=1,NEIGMA 
SIGMA2  =  SIGMA(K)+e2 

sigim=ii*sigma(k) 

DO  1  1=1, NON 

RHSl(I)  =  -ENN(1,I,ISTA)*£IGIM 
RHS2(I)  =  -ENH(2.1,ISTA)*SIGIM 
RHS3(l)  =  -ENN(3.I,ISTA)*SIGIM 
RHS4(I)  =  -ENN(4.I,ISrA)*SIGIK 
1  CONTINUE 

*  the  lollowing  lour  cards  are  to  impose  a  rigid  wall  condition  on 
the  vaterline  segment  inside  the  section. 

IFC.NOT^  LID)  GO  TO  26 
KHbllNKl)  =  (0.0,  0.0) 

RES2(NPT)  =  (0.0,  O.C) 
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RHS3(NPT)  =  (0.0,  0.0) 

RHS4(NPT)  =  (0.0,  0.0) 

25  CONTINUE 

CALL  GRNFRQ(  YS ,  ZS,  NARG ,  SIGMA2,  POTLOG .  PTNLOG,  CN .  SN , 

CTV,  CTL,  GREENV,  GREENL) 

*  for  the  algebraic  equation  AX=B,  CDCOMP  makes  an  inversion  of 

*  the  matrix  A,  and  CSOLVE  provides  the  solution  vector  X  by 

*  X=(INVERTED  A)B 

CALL  CDCOMP C  NARG,  10,  CTV,  UV,  IPV) 

IF  (IPV(NARG)  .EQ.  0)  GO  TO  17 

CALL  CSOLVE(  NARG,  10,  UV,  RHSl,  Ql,  IPV) 

CALL  CSOLVE(  NARG,  10,  UV,  RHS3.  Q3,  IPV) 

IF  (.NOT.  LAT)  GO  TO  20 

CALL  CDCOMP  (NARG,  10,  CTL,  UL,  IPL) 

IF  (IPL(NARG)  .EQ.  0)  GO  TO  17 

CALL  CSOLVE  (NARG,  10,  UL,  RKS2 ,  QZ,  IPL) 

CALL  CSOLVE  (NARG,  10,  UL,  RKS4,  Q4,  IPL) 

20  CONTINUE 

DO  2  1=1, NON 
PHI2D(K,I,1)  =(0  ,  0.) 

PHI2D(K,I,3)  =(0.  ,  0.) 

DO  2  J=1,NARG 
FAC=GREENV(I, J)*FACTOR 
PH12D(K,I,1)  =  PHI2D(K,I,1)+Q1(J)*FAC 
PHI2D(K,I,3)  =  PHI2D(K,I,3)+Q3(J)*FAC 
2  CONTINUE 

*  PHI2DS  are  to  be  interpolated  or  extrapolated  linearly  from  the 

*  midpoint  of  the  segments  to  the  offset  points. 

*  QI  arrays  are  to  be  used  for  temporary  storage  for  PHI2DS 

DO  160  N=2,N0N 
NM  =  N  -  1 


qi(N 

)  =  Wl(l 

I)ePHI2D( 

;k,nm,i) 

+  W2(l 

n*PHI2D(K,K.l) 

q3(N 

)  =  wio 

l)*PHI2D( 

.K,NM,3) 

+  W2(I 

jWpHI2D(K.N.3) 

150  CONTINUE 

KM  =  NON  “  1 

qi(l)  =  W1(1)*PHI2D(K,1,1)  +  W2(1)»PHI2D(K,2,1) 

Q3(l)  =  W1(1)*PHI2D(K,1,3)  +  W2( 1)*PHI2D(K ,2,3) 

QI(NPT)  =  W1(NPT)*PH12D(K,NM,1)  +  W2(NPT)«PHI2D(K,N0N,1) 
Q3(NPT)  =  M1(NPT)+PHI2D(K,HM,3)  +  W2(NPT)*PHI2D(K ,NON ,3) 
DO  DO  1=1, HPT 
PHI2D(K,I,1)  =  OKI) 

90  PHI2D(K,I.3)  =  Q3(I) 

IF(.NOT.  LAT)  GO  TO  10 
DO  6  1=1, NON 
PHI2D(K,I,2)  =(0.  ,  0.) 

PHI2D(K,I,4)  =(0.  ,  0.) 

DO  6  J=1,HARG 
FAC=GREENL(I , J ) ♦FACTOR 
PHI2D(K,I,2)  =  PH12D(K,I,2)+Q2(I)^FAC 
5  PHI2D(K,I,4)  =  PHI2D(K,I,4)+Q4(JWfAC 
DO  160  N=2,N0N 
NM  =  N  -  1 

q2(N)  =  W1(N)*PHI2D(K,HM,2)  +  W2(N)*PHI2D(K,N,2) 
q4(N)  =  W1(nWpHI2D(K,NM,4)  +  W2(N)^PHI2D(K,N,4) 

160  CONTINUE 

NM  ~  NON  ~  1 

q2(l)  =  Wl(l)^PHI2D(K,l,2)  +  W2(l)*Pni2D(K,2,2) 

Q4(l)  =  W1(1)+PHI2D(K,1,4)  +  W2(1)^PHI2D(K,2,4) 
q2(NPT)  =  W1(KPT)^PHI2D(K,HM,2)  +,  W2(NPT)*PHI2D(K ,NON ,2) 
q4(NPT)  =  W1(NPtWpHI2D(K,HM.4)  +  W2(nPT)*PHI2D(K,N0N,4) 
DO  97  1=1, HPT 
PHI2D(K,I,2)  =  q2(I) 

97  PHI2D(K,I,4)  =  q4(I) 

10  CONTINUE 
GO  TO  19 

If  WKiit.  (IrRIK,iS)  K 

18  FORMAT  (////  10X,'TWODPT  --  SINGULAR  MATRIX  AT  K=’,  13) 
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STOP 

19  CONTINUE 

*  patch  to  obtain  correct  potential 

DO  32  K=1,NSIGMA 
DO  30  1=1, NPT 

DO  31  J=l,4 

PHI2D(K ,I ,  J)  =  -CDNJG(PHI2D(K,I.J)) 

31  CONTINUE 

PH12D(K,I,4)=LPP+PRI2D(K,I,4) 

30  CONTINUE 

32  CONTINUE 

DO  76  I=1,NSIGMA 
SIGHA(I)  =  SIGMA(1)/SQRLG 
75  CONTINUE 

DO  80  J=1,NPT 

ENN(4.J,ISTA)  =  ENH(4,J,ISTA)»LPP 
YY(J,ISTA)  =  YY(J ,ISTA)*LPP 
ZZd.ISTA)  =  ZZ(J,ISTA)*LPP 
80  CONTINUE 

RETURN 

END 


c  DECK  Subroutine  VELACC  (im,it,grav.nl,nu,omegae,raoi,phsi,rao2,phs2, 

2  NOMEGA.NPLANE.IPHS) 

*  Tnis  routine  obtains  the  velocity  and  acceleration  raos  and 

*  phase  angles  ^or  motions  at  the  origin  and  at  a  point. 

*  W.G. MEYERS,  DTNSRDC,  100477 

DIMENSION  OMEGAE(NOMEGA) ,RA01 (NOMEGA) .PHSl (NOMEGA) ,RA02(N0MEGA) , 
2  PHS2(N0MEGA) 

GRAV2  =  GRAVeGKAV 
DO  20  I=NL,NU 

QMEGE2  =  OMEGAE(I)*OMEGAE(I) 

0MEGE4  =  0MEGE2>0HEGE2 

IF  <It''eq!2  .AND.  J.EQ.l)  RA0l{I)  =  RAOl  ( I )  *0MEGE2 
IF  (IT.EQ.2  .AND.  J.EQ.2)  RA02(l)  =  RA02(I)*0MEGE2 
IF  (IT.EQ.3  .AND.  J.EQ.l)  RAOl(I)  =  RA01(I)*0MEGE4 


J.EQ.2) 

IF  (IT.Eq.3  .AND.  J.EQ.l)  RAOl(I) 
IF  (IT.EQ.3  .AND.  J.EQ.2)  RA02(l) 
IF  (IT.EQ.3  .AND.  IM.LT.4  .AND.  J 
IF  (IT.EQ.3  .AND.  IM.LT.4  .AND.  J 
IF  (IPHS  .EQ.  0)  GO  TO  10 
IF  (IT.Eq.2  .AND.  J.EQ.l)  PHSl(I) 
IF  (IT.EQ.2  .AND.  J.EQ.2)  PHS2(I) 
IF  aT.EO.3  .AND.  J.EQ.l)  PHSl(l) 


J.EQ.2)  RA02( 
IM.LT.4  .AND. 
IM.LT.4  .AND. 


RAOl(I) 
RA02(l) 
.AND.  J 
.AND.  J 


IF  (IT.EQ.2  .AND.  J.EQ.2)  PHS2(I) 
IF  (IT.EQ.3  .AND.  J.EQ.l)  PHSl(l) 
IF  (IT.EQ.3  .AND.  J.EQ.2)  PHS2(I) 
CONTINUE 
CONTINUE 


=  RA01(I)*0MEGE2 
=  RA02(l)*0MEGE2 
=  RA01(I)*0MEGE4 
=  RAO2(l)*0MEGE4 
.EQ.l)  RADl(I)  =  RADUI)/GRAV2 
.EQ.2)  RA02(l)  =  RA02(l)/GRAV2 

=  PHSl (I)  +  90. 

=  PHS2(l)  +  90. 

=  PHSl(l)  +  180. 

=  PHS2(I)  +  180. 


RETURN 

END 


C  DECK  Vise 

SUBROUTINE  VISC 

COMMON  /CH3D/  ISIGMA . SIGMIN ,SIGMAX ,V, SINMU , COSMU ,WTSI , 

2  IMMIN.IMMAX.IMDEL.LMIN.LMAX 

REAL  SIGMIN, SIGMAX.V, SINMU, COSMU, WTSI (4) 

INTEGER  ISIGMA , IMMIN , IMMAX . IMDEL , LMIN . LMAX 

COMMON  /ENVIOR/  VK , NVK , MU ,NMU .OMEGA .NOMEGA , SIGMA .NSIGMA , SIGWH , 

1  N3IGWH , TMODAL , NTMOD , NRANG , RANG , RLANG , S , NNMU , ^RNUM . VFS 
INTEGER  NVK . NMU  .NOMEGA  - »SIGMA .NSIGVH , NTMOD  , NMNG  .NNMU (8 >  . 
REAL  VK(8) ,MU(37,8) ,0MEGA(30) ,SIGMA(10) ,EIGWH(4) .TM0DAL(8) , 

2  RANG(8) ,RLANG(8) .S(30,8) ,FRNUM(8) ,VFS(8) 
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COMMON  /GEOM/  X .NSTATN .Y ,2 . NOFSET.LPP , BEAM .DRAFT .LCF , 

1  VCG . GM .DELGM .NEBLA .KPITCH .KROLL .KYAW.KYAWRL, AWP , VCB ,FBDX , FBDV , 

2  FBDZ , NFREBD , XPT , YFT , ZPT . NPTS , LCB . GML , ASTAT , BSTAT , TITLE , M ASS , 

D  DlSPLM , IPITCH , IROLL . lYAU , lYAWRL .CHEAVE .CPITCH .ClIEAPI , CROLL , 

2  AREAMX.WSl'RF, GIRTH, FEDZA'.DBLUL.TLCB 

INTEGER  NSTATN, N0FSET(2&) .NFREBD, NPTS 
CKARACTER*4  TITLE(20) 

REAL  X(26) ,Y( 10,25) ,2(10,25) .FED2V (8 , 10) . LPP , BEAM .DBLWL . TLCP , 

2  DRAFT , LCF ,VCG , GH, DELGM .NEBLA .KPITCH , KROLL, KYAW .KYAURL , AUP , VCB , 

2  FBDX(10),FBDY(10) .FBDZUO) , XPT( 10) ,YPT(10) ,2PT(1 0 ) , LCB , GML , 

4  ASTAT(25) ,BSTAT(25) .MASS .DlSPLM , IPITCH . IROLL , lYAW , 

5  lYAWRL , CHEAVE , CPITCH .CHEAPI .CROLL , AREAMX, WSORF , GIRTH (25) 

COMMON  /PHYSCO/  II .TPI .PI .PIOT, DEGRAD, RADDEG .VKHETR.METRVK ,GRAV . 

2  RHO . GNU , RHOS , RHOF . GNUS , GNUF . FTMETR . PUN ITS , REYSCL 
COMPLEX  II 

CHARACTER+4  PUNITS(2) 

REAL  TPI , PI , PIOT .DEGRAD , RADDEG , VKMETR , METRVK , GRAV , RHO , GNU  .  RHOS , 

1  RHOF, GNUS. GNUF, FTMETR 

COMMON  /RLDBK/  PSUR(25) ,BMK(25) ,DK(25) , CAK (25) , HQ .HSPAN , HHNCHD  , 

2  HAREA.HXCP,HYCP,HZCP,HGAMMA.HYHAT,H£AR,HLCS.RQ(2) ,RSPAN(2) . 

2  RMNCHD(2) , RAREA (2 ) ,RXCP (2) ,RYCP(2) .RZCP(2) ,Rr.AMMA(2) ,RYHAT(2) , 

2  REAR(2) ,RLCS(2) ,SQ( 2) . SSPAN (2) . SMNCHD( 2) , SAREA( 2 ) ,SXCP(2) . 

2  SYCP(2),SZCP(2) ,SGAMMA(2) ,SYHAT(2),SEAR(2),SLCS(2),BQ(2) , 

2  BSPAN(2)  ,BMNCHD(2) ,BAREA(2) ,BXCP(2) , BYCP(2 ) , B2CP ( 2) , BGAMMA (2) , 

2  BYHAT(2) ,BEAR(2) ,BLCS(2) ,FQ(2) .FSPAH(2) ,FHNCHD(2) -FAREA(2) . 

2  FXCP(2) ,FYCP(2) .FZCP(2) ,FGA:1MA(2) ,FYHAT(2) ,FEAR(2 ; , FLCS (2 ) . 

2  PQ(2.2) .PSPAN(2.2) , PMNCHD( 2 , 2) . PAREA (2 , 2) , PXCP (2 , 2) , PYCP (2 , 2) , 

2  PZCP(2,2) ,PGAMMA(2,2) .PYHAT(2,2) .PEAR(2,2) ,PLCS(2,2) , 

2  STAraP(lO) ,SHPDMP(10,8) ,ENCON .WPHI ,TPHI .WHELM(4 , 9 ) , SFELM ( 4 ,9 , 8 ) , 

2  REELiH4,9,8) ,PEELM(4 .9 ,8) .FEELM(4 ,9 , 8) , HEELM(4 ,9 , 8) , BEELM(4 , 9 , 8 ) , 
2  EKWM.Ei<'3F(8,e)  .EHRE(8)  ,ENPE(8)  ,ENFE(6)  ,ENHE(8)  ,ENBE(8), 

2  ENEHV(;8,8' ,ENRL(8) .ENPL(8) .ENFL(8) ,ENHL(8) ,ENSL(8) ,ENBL(8) , 

2  ENSHP(8,8) ,RELM(4,9) , ITS(26) . RD(25) , EDDY(8 ,25) ,RGB(26) 

REAL  RDBLK(2692) 

EQUIVALENCE  (FSUR( 1 ) .RDBUK 1) ) 

DO  10  IA=1,NAANG 
DO  10  IS=1,NSIGMA 
SHPDMPdS.IA)  =  0 
10  CONTINUE 

DO  40  K=l. NSTATN 

IF  (KOFSET(K)  .LT.  2)  GO  TO  40 

CON  =  4./(3>PI)*RH0*PSUR(K)*RGB(K)**3 

DO  30  IA=1,NRANG 

DO  20  IS=1,NSIGMA 

STADMP(ISl  =  CON*SIGMA(IS)*RANG(IA)*EDDY(IA,K) 

STADMP(IS)  =  SIGMA(IS)*STADMP(IS) 

SHPDMPdS.IA)  =  SHPDMPdS.IA)  +  STADMPdS) 

20  CONTINUE 
30  CONTINUE 
40  CONTINUE 

DO  60  IA=1,NRAKG 

CALL  SPFIT  (SIGMA, SHPDMPd, lA)  .HEELMd.l.IA)  .NSIGMA) 

ENHE(IA)  =  ENCON*REVAL(HEELMd,ISIGMA,IA),WTSI) 

50  CONTINUE 

RETURN 

END 

C  DECK  VUNIT2 

SUBROUTINE  VUNIT2  (VI,  SI,  V2) 

f  VUNIT2  created  Irom  VUNIT  (  NAVSEC-N066  )  -  A  M  REED  JULY  1976 
*  \initiz«s  plane  direction  vector 

DIMENSION  Vl(2),  V2(2) 

S  =  SqRT(  V2(1)*V2(1)  +  V2(2)*V2(2)  ) 

IF  (S  .LE.  O.OOOOOl*(ABS(V2d))+ABS(V2(2))))  GO  TO  2000 
S1=S 
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VI ^1}=V2(1)/S 
V] (2)=V2(2)/S 
GD  TO  99999 
2000  CONTINUE 
S1=0.0 
VlClUO.O 
VI  (2U0.0 
99999  CONTINUE 

RETURN 

END 

C  DECK  WAVMAK 

SUBROUTINE  WAVMAK 

COMMON  CH3D/  ISIGHA .SIGMIN .SIGMAX , V .SINMU .COSHU , WTSl , 

2  IMMIN.MMAX.IMDEL.LMIN.LMAX 

REAL  S.GMIK .SIGMAX, V.SINMU.COSMU.VTSl (4) 

INTEGER  ISIGHA, IMMIN.IMMAX.IMDEL.LMIN.LMAX 

COMMON  /ENVIOR/  VK , NVK ,KU . NMU .OMEGA .NOMEGA , SI GMA , NSI GHA , SIGWH , 

1  NSIGWH . TMODAL . NTMOD . NRANG . RANG .RLANG ,S . NNMU .FRNUH , VFS 
INTEGER  NVK.NMU.KOMEGA.NSIGMA, NSIGWH. NTMOD, NRANG, NNMU (8^ 

REAL  VK(8)  .MU(37,e)  .OMEGAuTO)  .SIGMAdO)  , SIGWH ( 4 ) , TMDDALl 8 1  . 

2  RANG (8) .RLANG( 8) ,3(30,8) .FRNUMCe) ,VFS(8) 

COMMON  /GEOM/  X . NSTATN . Y .Z , NOFSET .LPP .BEAM .DRAFT , LCF , 

5  VCG.GM.DELGM.NEBLA.KPITCH.KROLL.KYAW.KYAURL.AVP.VCB.FBDX ,FBDY, 

2  FBDZ . NFREBD , XPT , YPT , ZPT , NPTS , LCB . GML . ASTAT . BSTAT . TITLE . M ASS , 

2  DISPLM.IPITCH.IRQLL.IYAW.IYAWRL.CHEAVE.CFITCH.CHEAPI ,CROLL, 

2  AREAMX.WSURF, GIRTH, FBDZV.DBLWL.TLCB 
integer  NSTATN .N0FSET(25) .NFREBD, NPTS 
CHARACTER*4  TITLE(20) 

REAL  X(26) .Y( 10,23) .Z(10 ,25) ,FBDZV(8, 10) ,LPP .BEAM .DBLWL.TLCB , 

2  PRAFT.T.CF.VCG.GM.DELGM.NEBLA.KPITCH.KROLL.KYAW.KYAWRL.AWP.VCB, 

2  FBDX(10),FBDY(10) ,FBDZ(lO) .XPT(IO) ,YPT(10) .ZPT(IO) .LCB.GML. 

4  ASTAT(25) .BSTAT(25) .MASS .DISPLM .IPITCH .IROLL.IYAW . 

6  IYAWRL.CHEAVE,CPITCH,CHEAP1.CR0LL.AREAMX,WSURF,GIRTH(23) 

COMMON  /INDEX/  PFIDX.LPFIDX ,RM1DX,LRMIDX,SV1DX,LSV1DX 

INTEGER  LPFIDX.LRHIDX.LSVIDX 

REAL  PFIDX(235) ,RM1DX(183) ,SVIDX(3) 

COMMON  /lO/  SYSFIL.POTFIL.COFFIL.LCOFIL.ICARD.TEXriL.IPRIN, 

2  SCRFIL,HPLFIL,LRAFIL,0RGFIL,HA0FIL,RMSF1L,SEVFIL,S?DF1L, 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL.POTFIL.COFFIL.LCOFIL.ICARD.TEXFIL.IPRIN, 

2  SCRFIL,HPLFIL,LRAFIL,0RGFIL.RADFIL,RHSFIL.SEVFIL,SPDF1L, 

2  SPTFIL.LACFIL.LAEFIL 

COMMON  /PHYSCO/  II .TPI .PI .PIOT. DEGRAD, RADDEG ,VKMF.TR,METRVK ,GRAV , 

2  RHO , GNU , RBOS , RHOF , GNUS , GNUF , FTMETR , PUNITS , REYSCL 
COMPLEX  II 

CHARACTER*4  PUNITS(2) 

REAL  TPI , PI , PIOT , DEGRAD , RADDEG, VKMETR .METRVK , GRAV ,RHQ , GNU , RHOS , 

1  RHOF, GNUS, GNUF, FTMETR 

COMMON  /RLDBK/  PSUR(26) ,BMK(25) ,DK(2S) ,CAK(25) .HQ .HSPAH .HMNCHD . 

2  IIAREA,RXCP,HYCP,HZCP,HGAMMA.HYHAT,HEAR,HLCS,RQ(2) ,RSPAH(2) , 

2  RMNCHD(2) ,RAREA(2) ,RXCP(2) ,RYCP(2) ,RZCP(2) ,RGAMMA(2) ,RYHAT(2) , 

2  REAR(2),RLCS(2) ,SQ(2) ,SSPAN(2) ,SMNCHD(2) ,SAREA(2) .SXCP(2) , 

2  SyCP(2),SZCP(2) ,SGAMMA(2),SYHAT(2),SEAR(2),SLCS(2),BC|(2) , 

2  BSPAN{2) ,BMNCHD(2) ,BAREA(2) ,BXCP(2) , BYCP(2) . BZCP (2) . BGAMMA (2) , 

2  BYHAT(2) ,BEAR(2) ,BLCS(2) ,FQ(2) ,FSPAH(2) ,FHNCHD(2) ,FAREA{2) . 

2  FXCP(2) .FYCP(2) ,FZCP(2) ,FGAMMA(2) ,FYHAT(2) .FEAR(2),FLCS(2) , 

2  PQ(2,2) ,PSPA»(2,2),PMNCHD(2,2),PAREA(2,2),PXCP(2.2),PYCP(2,2) , 

2  PZCP(2,2),PGAMMA(2.2),PYHAT(2.2).PEAR(2,2),FLCS(2,2) , 

2  STADMP(IO) ,SHPDMP(10,8) .ENCON .WPHI ,TPHI .WMELM(4 , 9) , SKELM(4 , 9 , 8 ) , 

2  REELM(4,9,8) , PEELM(4 ,9 , 8) ,FEELM{4 ,9 ,8) .HEELM(4 .9 , 8) ,BEELM(4 ,9 , 8) , 
2  ESy“,EHSF(S,S)  ,E“RE(6''  FNPF.ffl'l  .CKFE(8)  .ENHE(8)  .ENBE(8) . 

2  ENEMV(8,8) ,ENRL(8) ,ENPL(8) ,ENFt(8),ENHL(8) .EKSL(8) ,ENBL(8) , 

2  ENSHP(8,8) ,RELH(4,9) ,ITS(25) ,RD(26) .EDDY(8,28) ,RGBC26) 


1% 


REAL  RDBLK(2692) 

EQUIVALENCE  CPSUR( 1 ) , RDBLK( 1 ) ) 


COMMON  /SMPSYS/  FIS , AS . SIS . SOS , SDS ,K ALO? .OEV ,PRN , SMFPS . SMP IS , 
2  SHPOS.SMPDS.SHPTYPS, SHIPS, VARS, CYCLS, TITLES. OPTION, LSIS.LSOS , 
2  LSDS , LH ALOS , LPEV . LPRN , LSMPPS .LSMPIS , LSMPOS . LSMPDS , LSHPTYPS , 

2  LSHIPS.LTITLES 
CHARACTER* 160  AS 

CH ARACTER*80  FIS , SIS , SOS , SDS .TITLES 

CHARACTER*20  HALOS , DEV .PRN . SMPPS .SMPIS .SMPOS .SMPDS , SHPTYPS 
CHARACTER  SHIPS*6 , VARS*2 , CYCLS*2 
INTEGER+2  OPTION 


COMMON  /TELEM/  TELEM 
COMPLEX  TELEM(4,9,10) 

COMPLEX  T22.T24 ,T42 , T44 , T44G ( 10) ,CELM(4,9) ,CT44G,CDUK 
REAL  IR0LLG,144G 
DATA  EPS  /0.25/ 

FIS  =  SDS(1 :LSDS)//' .COF‘ 

OPEN  (UNIT=CQFFIL.FILE=FIS,FORM- •UNFORMATTED ' .STATUS- ‘ UNKNOWN  ’  ) 
READ  (CDFFIL)  TELEM 
CLOSE  (UN1T=C0FFIL) 

*  wavemaking  (origin  at  VCG) 


DO  10  1S=1.NSIGMA 
JS  =  IS 
J  «  1 

IF  (It  .10.  NtlOHA) 
IF  (IS  .EQ.  NSIGMA) 
T44  *  TELEM(J,JS,6 
T22  =  TELEM(J,JS,6 
T24  =  TELEM(J,JS,8 


Jt  •  II 

J  *  3 


1 


*  translate  to  VCG 

T44G(IS)  •=  T44  +  VCG*(T24  +  T42  +  VCG*T22) 
SHPDMPdS.l)  =  AIMAG(T44G(IS)) 

10  CONTINUE 

CALL  CPFIT  (SIGMA. T44G,CELM. NSIGMA) 


*  lind  natural  roll  frequency 
C44  =  CRQLL 

IROLLG  =  MASS*(KR0LLeBEAM)**2 

I44G=  IROLLG 

WPHI  =  SQRT(C44/I44G) 

TPHI  =  TPI/WPHI 
IDOSE  =  C 
DO  20  1=1,10 
IT  c  1 
TS  =  TPHI 

CALL  CPLVAL  (SIGMA, NSIGMA, CELM, WPHI, CT44G.CDUM,1S1GMA) 
A44G  =  REAL(CT44G)/(-WPHl*e2) 

I44G=  IROLLG  +  A44C 
IF  (IDONE  .EQ.  1)  CO  TO  30 
WPHI  =  SQRT(C44/I44G) 

TPHI  =  TPI/WPHI 

IF  (ABS(TPHI-TS)  .LT.  EPS)  IDONE  =  1 
20  CONTINUE 
30  CONTINUE 

CALL  FINTSP  (WPHI) 

CALL  SPFIT  (SIGMA, SHPDMP.WMELM, NSIGMA) 

ENCON  =  l./(2.*C44) 

EKWM  =  ENCON  *  REVAL(WMELM(1 .ISIGMA) ,WTSI) 

RETURN 

END 


197 


C  DECK  WEDEFN 

subroutine  VJEDEFN  (NWEVN.UEVN) 

*  This  routine  calculates  the  evenl> -spaced  encounter  wave 

•  Trequencies  over  which  the  response  spectra  are  calculated. 

•  The  number  ol  frequencies  must  be  set  equal  to  lOO, 

*  W.G, MEYERS,  DTNSRDC,  072877 

DIMENSION  WEVN(NV'EVN) 

K  =  0 
DWE  -  0.01 
DO  110  3=1,84 
K  =  K  +  1 

110  WEVN(K)  =  0.05  +  (l-ll*DWE 
DUE  =0.02 
DO  120  1=1,21 
K  =  K  t  1 

120  WEVN(K)  =  VEVN(54l-ti.DWE 
DWE  =0.10 
DO  130  3=1  , 10 
K  =  K  +  1 

130  WEVN(K)  =  WEVN(75)HeDWE 
DWE  =0.2 
DO  140  3  =  1  , 10 
K  =  K  +  1 

140  VEVN(K1  =  WEVNCeSltleDWE 
DWE  =  0.4 
DO  160  1=1,5 
K  =  K+1 

150  UEVN(K)  =  WEVN(e5)t3eDWE 

RETURN 

END 

C  DECK  WTPELM 

SUPROUTTNE  WTPELM (I 3TATN,  PELEK) 

*  writes  out  spline  elements  for  2-d  potential  and  forces 

•  W.  R.  MCCREIGHT  DTNSRDC  JULY, 1977 

COMMON  /EKVIOR/  VK .NVK. MU ,NMU .OMEGA ,N0MEGA , SIGMA ,NS3GMA , SIGWH , 

1  »S1GWH,TM0DAL.NTM0D,NRaNG.RANG,RLANG.S,NNHU,FRNUM,VFS 
INTEGER  HVK,NMU,N0MEGA,NS3GMA,NSIGUH.NTH0D,NRANG,NKMU(8) 

REAL  VK(e) ,MU(37,e),0MEGA(30).SIGMA(l0),SIGWU(4) ,TM0DAL(8) , 

2  RAKGO)  ,RLANG(8).S(30.8)  .FRNUH(8)  .VFS(8) 

COMMON  /GEOM/  X , HSTATN .Y ,2 .NOFSET.LPP , BEAM .DRAFT , LCF . 

1  VCG , GK , DELGM , KEBLA .KPiTCH , KROU.  ,KY AW . KY AWRL , AWP , VCB , FBDX . FBDY , 

2  FBDZ , NFREBD , XPT , YPT , ZPT , NPTS ,LCB , GHL , ASTAT , BSTAT , TITLE , MASS , 

2  DISPLM,IPITCH,IR0LL,IYAW.IYAWRL.CHEAVE.CPITCH,CHEAP1,CR0LL, 

2  AREAMX.WSURF, GIRTH, FBDZV.DBLWL.TLCB 

INTEGER  NSTATN,»0FSET(26) , NFREBD, KPTS 
CHARACTER*4  TITLEt20) 

REAL  X(26) ,Y(10,2S).Z(10,25).FBDZV(8,10).LPP.BEAM.DBLWL.TLCE, 

2  DRAFT, LCF , VCG , CM, DELGH .NEBLA .KPITCH .KROLL.KYAW .KYAURL , AWP , VCB , 
2  FBDX(10),FBDY(10)  ,FBD2(lO) ,XPT(10) ,YPT(10) ,ZPT(10) ,LCB,GML. 

4  ASTATC 25 ) , BSTATC 25 ) . MASS .DISPLM . IPITCH , IROLL . 1 YAW , 

5  lYAWRL , CHEAVE , CPITCH , CBEAPI . CROLL , AREAMX , WSURF . GI RTH ( 25 ) 

COMMON  /index/  PFIDX.LPFIDX ,RMIDX,LRMIDX,SVIDX,LSVIDX 

INTEGER  LPFIDX.LRMIDX.LSVIDX 

REAL  PF1DX(23S),RMIDX(183) ,SVIDX(3) 

COMMON  /lO/  SYSFIL,P0TFIL,C0FFIL,LC0FIL,ICARD,TEXFIL,IPR1N, 

2  SCRFIL.HPLFIL.LRAFIL.ORGFIL.RADFIL.RMSFIL.SEVFIL.SPDFIL, 

2  SPTFIL.LACFIL.LAEFIL 

INTEGER  SYSFIL,P0TF1L,C0FFIL,LC0F1L,ICARD,TEXFIL.IPR1H, 

2  SCRFIL,HPLFIL.LRAFIL,ORGF1L,RAOFIL,RMSFIL,SEVF1L,SPDFIL, 

2  SPTFIL.LACFIL.LAEFIL 

CCMMQK  /STATE/  VRT  I.OiDS.ADDRES. SALT, HEAD. EXROLL, BKEEL 
LOGICAL  LAT , VRT , LOADS , ADDRES , SALT , HEAD .EXROLL . BKEEL 
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M  rjj  ^ 


DIMENSION  IlftTA(,3:o') 
COMPLEX  rELEMU,v>.40) 


IF  (NOE'SETdSTATN)  .EE.  0)  KETURN 
IMMIN-1 

IF  (.NOT,  VRi)  IMM]N=2 
IMHAX^'? 

IF  (.NOT,  LAT)  IMHAX-? 

IHDEL=2 

IF  (VRT  .AND.  LAT)  IHbEL=l 

ipchx^nsigma-; 

DO  3  IGlGKA^l.ISGMX 
NEXT=1 

NNODE=NOFSET ( ISTATN ) 

DO  2  J=1,NNCDE 
DO  3  imodf,=  ihhin,immax,ihdel 
DO  4  1=1,4 

lDX  =  (INOnF,-l  )*lO-t  J 

DATA (NEXT )=REAL(PELEM(1 . ISIGMA . IDX ) ) 

DATA(NEXT^  3)sAIKAG(rELEM(l .ISIGMA.IDX) ) 
NEXT=NEXT+2 
CONTINUE 
CONTINUE 
CONTINUE 
NDATF-^KKXT*^! 

INDEX' (1S1GMA-1)*N5TATN+1STATK 

*  change  lor  VAX-ll  version. 

*  CDC  CALL  VRITMSCPOTFXL.DAT.A.NDATP.INDSX) 

V'RITF.  (POTFIL.REC'INUEX)  DATA 

1  CONTINUE 

RETURN 

END 

C  DECK  XMSSC 

SUBROUTINE  XMSSC  (IPH,B2.>'.SLC,NLCH,RHSLC,RHSSC) 

DIMENSION  B2(NLCH) 

REAL  MSLC(24) .MSSC 
MSSC  -  0, 

LH  «  IPH  -  1 
DO  10  IH=1,NLCH 
LH  «  LH  +  1 

IF  (LH  .Cr,  24)  LH  =  LH  -  2^ 

MSSC  «  MSSC  +  B2(IH)*MSLC(LH) 

10  CONTINUE 

KH  '  IPH  ♦  t 

IF  (KH  .GT.  :>4)  KB  =  KH  -  24 
HHSLC  =  MSLC(KH) 

RKSSC  =  MSSC 


RETURN 

END 
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